git.chise.org Git - elisp/gnus.git-/blob - lisp/nnheader.el

   1 ;;; nnheader.el --- header access macros for Semi-gnus and its backends
   2
   3 ;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996,
   4 ;;        1997, 1998, 2000, 2001
   5 ;;        Free Software Foundation, Inc.
   6
   7 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
   8 ;;      Lars Magne Ingebrigtsen <larsi@gnus.org>
   9 ;;      MORIOKA Tomohiko <morioka@jaist.ac.jp>
  10 ;;      Katsumi Yamaoka <yamaoka@jpl.org>
  11 ;; Keywords: mail, news, MIME
  12
  13 ;; This file is part of GNU Emacs.
  14
  15 ;; GNU Emacs is free software; you can redistribute it and/or modify
  16 ;; it under the terms of the GNU General Public License as published by
  17 ;; the Free Software Foundation; either version 2, or (at your option)
  18 ;; any later version.
  19
  20 ;; GNU Emacs is distributed in the hope that it will be useful,
  21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 ;; GNU General Public License for more details.
  24
  25 ;; You should have received a copy of the GNU General Public License
  26 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  27 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  28 ;; Boston, MA 02111-1307, USA.
  29
  30 ;;; Commentary:
  31
  32 ;;; Code:
  33
  34 (eval-when-compile (require 'cl))
  35 (eval-when-compile (require 'static))
  36
  37 ;; Requiring `gnus-util' at compile time creates a circular
  38 ;; dependency between nnheader.el and gnus-util.el.
  39 ;(eval-when-compile (require 'gnus-util))
  40
  41 (require 'mail-utils)
  42
  43 ;; Reduce the required value of `recursive-load-depth-limit' for Emacs 21.
  44 (require 'pces)
  45 (require 'poem)
  46 (require 'std11)
  47
  48 (require 'mime)
  49 (eval-and-compile
  50   (autoload 'gnus-sorted-intersection "gnus-range")
  51   (autoload 'gnus-intersection "gnus-range")
  52   (autoload 'gnus-sorted-complement "gnus-range"))
  53
  54 (defcustom gnus-verbose-backends 7
  55   "Integer that says how verbose the Gnus backends should be.
  56 The higher the number, the more messages the Gnus backends will flash
  57 to say what it's doing.  At zero, the Gnus backends will be totally
  58 mute; at five, they will display most important messages; and at ten,
  59 they will keep on jabbering all the time."
  60   :group 'gnus-start
  61   :type 'integer)
  62
  63 (defcustom gnus-nov-is-evil nil
  64   "If non-nil, Gnus backends will never output headers in the NOV format."
  65   :group 'gnus-server
  66   :type 'boolean)
  67
  68 (defvar nnheader-max-head-length 4096
  69   "*Max length of the head of articles.
  70
  71 Value is an integer, nil, or t.  nil means read in chunks of a file
  72 indefinitely until a complete head is found\; t means always read the
  73 entire file immediately, disregarding `nnheader-head-chop-length'.
  74
  75 Integer values will in effect be rounded up to the nearest multiple of
  76 `nnheader-head-chop-length'.")
  77
  78 (defvar nnheader-head-chop-length 2048
  79   "*Length of each read operation when trying to fetch HEAD headers.")
  80
  81 (defvar nnheader-file-name-translation-alist nil
  82   "*Alist that says how to translate characters in file names.
  83 For instance, if \":\" is invalid as a file character in file names
  84 on your system, you could say something like:
  85
  86 \(setq nnheader-file-name-translation-alist '((?: . ?_)))")
  87
  88 (defvar nnheader-text-coding-system
  89   (if (memq system-type '(windows-nt ms-dos ms-windows))
  90       'raw-text-dos
  91     'raw-text)
  92   "Text-safe coding system (For removing ^M).
  93 This variable is a substitute for `mm-text-coding-system'.")
  94
  95 (defvar nnheader-text-coding-system-for-write nil
  96   "Text coding system for write.
  97 This variable is a substitute for `mm-text-coding-system-for-write'.")
  98
  99 (eval-and-compile
 100   (autoload 'nnmail-message-id "nnmail")
 101   (autoload 'mail-position-on-field "sendmail")
 102   (autoload 'message-remove-header "message")
 103   (autoload 'gnus-point-at-eol "gnus-util")
 104   (autoload 'gnus-buffer-live-p "gnus-util"))
 105
 106 ;;; Header access macros.
 107
 108 ;; These macros may look very much like the ones in GNUS 4.1.  They
 109 ;; are, in a way, but you should note that the indices they use have
 110 ;; been changed from the internal GNUS format to the NOV format.  The
 111 ;; makes it possible to read headers from XOVER much faster.
 112 ;;
 113 ;; The format of a header is now:
 114 ;; [number subject from date id references chars lines xref extra]
 115 ;;
 116 ;; (That next-to-last entry is defined as "misc" in the NOV format,
 117 ;; but Gnus uses it for xrefs.)
 118
 119 (require 'mmgnus)
 120
 121 (defmacro mail-header-number (header)
 122   "Return article number in HEADER."
 123   `(mime-entity-location-internal ,header))
 124
 125 (defmacro mail-header-set-number (header number)
 126   "Set article number of HEADER to NUMBER."
 127   `(mime-entity-set-location-internal ,header ,number))
 128
 129 (defalias 'mail-header-subject 'mime-gnus-entity-subject-internal)
 130 (defalias 'mail-header-set-subject 'mime-gnus-entity-set-subject-internal)
 131
 132 (defalias 'mail-header-from 'mime-gnus-entity-from-internal)
 133 (defalias 'mail-header-set-from 'mime-gnus-entity-set-from-internal)
 134
 135 (defalias 'mail-header-date 'mime-gnus-entity-date-internal)
 136 (defalias 'mail-header-set-date 'mime-gnus-entity-set-date-internal)
 137
 138 (defalias 'mail-header-message-id 'mime-gnus-entity-id-internal)
 139 (defalias 'mail-header-id 'mime-gnus-entity-id-internal)
 140 (defalias 'mail-header-set-message-id 'mime-gnus-entity-set-id-internal)
 141 (defalias 'mail-header-set-id 'mime-gnus-entity-set-id-internal)
 142
 143 (defalias 'mail-header-references 'mime-gnus-entity-references-internal)
 144 (defalias 'mail-header-set-references
 145   'mime-gnus-entity-set-references-internal)
 146
 147 (defalias 'mail-header-chars 'mime-gnus-entity-chars-internal)
 148 (defalias 'mail-header-set-chars 'mime-gnus-entity-set-chars-internal)
 149
 150 (defalias 'mail-header-lines 'mime-gnus-entity-lines-internal)
 151 (defalias 'mail-header-set-lines 'mime-gnus-entity-set-lines-internal)
 152
 153 (defalias 'mail-header-xref 'mime-gnus-entity-xref-internal)
 154 (defalias 'mail-header-set-xref 'mime-gnus-entity-set-xref-internal)
 155
 156 (defalias 'nnheader-decode-subject
 157   (mime-find-field-decoder 'Subject 'nov))
 158 (defalias 'nnheader-decode-from
 159   (mime-find-field-decoder 'From 'nov))
 160
 161 (defalias 'mail-header-extra 'mime-gnus-entity-extra-internal)
 162 (defalias 'mail-header-set-extra 'mime-gnus-entity-set-extra-internal)
 163
 164 (defun nnheader-decode-field-body (field-body field-name
 165                                               &optional mode max-column)
 166   (mime-decode-field-body field-body
 167                           (if (stringp field-name)
 168                               (intern (capitalize field-name))
 169                             field-name)
 170                           mode max-column))
 171
 172 (defsubst make-full-mail-header (&optional number subject from date id
 173                                            references chars lines xref
 174                                            extra)
 175   "Create a new mail header structure initialized with the parameters given."
 176   (luna-make-entity (mm-expand-class-name 'gnus)
 177                     :location number
 178                     :subject (if subject
 179                                  (nnheader-decode-subject subject))
 180                     :from (if from
 181                               (nnheader-decode-from from))
 182                     :date date
 183                     :id id
 184                     :references references
 185                     :chars chars
 186                     :lines lines
 187                     :xref xref
 188                     :original-header (list (cons 'Subject subject)
 189                                            (cons 'From from))
 190                     :extra extra))
 191
 192 (defsubst make-full-mail-header-from-decoded-header
 193   (&optional number subject from date id references chars lines xref extra)
 194   "Create a new mail header structure initialized with the parameters given."
 195   (luna-make-entity (mm-expand-class-name 'gnus)
 196                     :location number
 197                     :subject subject
 198                     :from from
 199                     :date date
 200                     :id id
 201                     :references references
 202                     :chars chars
 203                     :lines lines
 204                     :xref xref
 205                     :extra extra))
 206
 207 (defsubst make-mail-header (&optional init)
 208   "Create a new mail header structure initialized with INIT."
 209   (make-full-mail-header init init init init init
 210                          init init init init init))
 211
 212 ;; fake message-ids: generation and detection
 213
 214 (defvar nnheader-fake-message-id 1)
 215
 216 (defsubst nnheader-generate-fake-message-id ()
 217   (concat "fake+none+" (int-to-string (incf nnheader-fake-message-id))))
 218
 219 (defsubst nnheader-fake-message-id-p (id)
 220   (save-match-data                      ; regular message-id's are <.*>
 221     (string-match "\\`fake\\+none\\+[0-9]+\\'" id)))
 222
 223 ;; Parsing headers and NOV lines.
 224
 225 (defsubst nnheader-header-value ()
 226   (let ((pt (point)))
 227     (prog2
 228         (skip-chars-forward " \t")
 229         (buffer-substring (point) (std11-field-end))
 230       (goto-char pt))))
 231
 232 (defun nnheader-parse-head (&optional naked)
 233   (let ((case-fold-search t)
 234         (cur (current-buffer))
 235         (buffer-read-only nil)
 236         in-reply-to lines p ref)
 237     (goto-char (point-min))
 238     (when naked
 239       (insert "\n"))
 240     ;; Search to the beginning of the next header.  Error messages
 241     ;; do not begin with 2 or 3.
 242     (prog1
 243         (when (or naked (re-search-forward "^[23][0-9]+ " nil t))
 244           ;; This implementation of this function, with nine
 245           ;; search-forwards instead of the one re-search-forward and
 246           ;; a case (which basically was the old function) is actually
 247           ;; about twice as fast, even though it looks messier.  You
 248           ;; can't have everything, I guess.  Speed and elegance
 249           ;; don't always go hand in hand.
 250           (make-full-mail-header
 251            ;; Number.
 252            (if naked
 253                (progn
 254                  (setq p (point-min))
 255                  0)
 256              (prog1
 257                  (read cur)
 258                (end-of-line)
 259                (setq p (point))
 260                (narrow-to-region (point)
 261                                  (or (and (search-forward "\n.\n" nil t)
 262                                           (- (point) 2))
 263                                      (point)))))
 264            ;; Subject.
 265            (progn
 266              (goto-char p)
 267              (if (search-forward "\nsubject:" nil t)
 268                  (nnheader-header-value) "(none)"))
 269            ;; From.
 270            (progn
 271              (goto-char p)
 272              (if (search-forward "\nfrom:" nil t)
 273                  (nnheader-header-value) "(nobody)"))
 274            ;; Date.
 275            (progn
 276              (goto-char p)
 277              (if (search-forward "\ndate:" nil t)
 278                  (nnheader-header-value) ""))
 279            ;; Message-ID.
 280            (progn
 281              (goto-char p)
 282              (if (search-forward "\nmessage-id:" nil t)
 283                  (buffer-substring
 284                   (1- (or (search-forward "<" (gnus-point-at-eol) t)
 285                           (point)))
 286                   (or (search-forward ">" (gnus-point-at-eol) t) (point)))
 287                ;; If there was no message-id, we just fake one to make
 288                ;; subsequent routines simpler.
 289                (nnheader-generate-fake-message-id)))
 290            ;; References.
 291            (progn
 292              (goto-char p)
 293              (if (search-forward "\nreferences:" nil t)
 294                  (nnheader-header-value)
 295                ;; Get the references from the in-reply-to header if there
 296                ;; were no references and the in-reply-to header looks
 297                ;; promising.
 298                (if (and (search-forward "\nin-reply-to:" nil t)
 299                         (setq in-reply-to (nnheader-header-value))
 300                         (string-match "<[^\n>]+>" in-reply-to))
 301                    (let (ref2)
 302                      (setq ref (substring in-reply-to (match-beginning 0)
 303                                           (match-end 0)))
 304                      (while (string-match "<[^\n>]+>"
 305                                           in-reply-to (match-end 0))
 306                        (setq ref2 (substring in-reply-to (match-beginning 0)
 307                                              (match-end 0)))
 308                        (when (> (length ref2) (length ref))
 309                          (setq ref ref2)))
 310                      ref)
 311                  nil)))
 312            ;; Chars.
 313            0
 314            ;; Lines.
 315            (progn
 316              (goto-char p)
 317              (if (search-forward "\nlines: " nil t)
 318                  (if (numberp (setq lines (read cur)))
 319                      lines 0)
 320                0))
 321            ;; Xref.
 322            (progn
 323              (goto-char p)
 324              (and (search-forward "\nxref:" nil t)
 325                   (nnheader-header-value)))
 326
 327            ;; Extra.
 328            (when nnmail-extra-headers
 329              (let ((extra nnmail-extra-headers)
 330                    out)
 331                (while extra
 332                  (goto-char p)
 333                  (when (search-forward
 334                         (concat "\n" (symbol-name (car extra)) ":") nil t)
 335                    (push (cons (car extra) (nnheader-header-value))
 336                          out))
 337                  (pop extra))
 338                out))))
 339       (when naked
 340         (goto-char (point-min))
 341         (delete-char 1)))))
 342
 343 (defmacro nnheader-nov-skip-field ()
 344   '(search-forward "\t" eol 'move))
 345
 346 (defmacro nnheader-nov-field ()
 347   '(buffer-substring (point) (if (nnheader-nov-skip-field) (1- (point)) eol)))
 348
 349 (defmacro nnheader-nov-read-integer ()
 350   '(prog1
 351        (if (eq (char-after) ?\t)
 352            0
 353          (let ((num (condition-case nil
 354                         (read (current-buffer))
 355                       (error nil))))
 356            (if (numberp num) num 0)))
 357      (unless (eobp)
 358        (search-forward "\t" eol 'move))))
 359
 360 (defmacro nnheader-nov-parse-extra ()
 361   '(let (out string)
 362      (while (not (memq (char-after) '(?\n nil)))
 363        (setq string (nnheader-nov-field))
 364        (when (string-match "^\\([^ :]+\\): " string)
 365          (push (cons (intern (match-string 1 string))
 366                      (substring string (match-end 0)))
 367                out)))
 368      out))
 369
 370 (defmacro nnheader-nov-read-message-id ()
 371   '(let ((id (nnheader-nov-field)))
 372      (if (string-match "^<[^>]+>$" id)
 373          id
 374        (nnheader-generate-fake-message-id))))
 375
 376 (defun nnheader-parse-nov ()
 377   (let ((eol (gnus-point-at-eol)))
 378     (make-full-mail-header
 379      (nnheader-nov-read-integer)        ; number
 380      (nnheader-nov-field)               ; subject
 381      (nnheader-nov-field)               ; from
 382      (nnheader-nov-field)               ; date
 383      (nnheader-nov-read-message-id)     ; id
 384      (nnheader-nov-field)               ; refs
 385      (nnheader-nov-read-integer)        ; chars
 386      (nnheader-nov-read-integer)        ; lines
 387      (if (eq (char-after) ?\n)
 388          nil
 389        (if (looking-at "Xref: ")
 390            (goto-char (match-end 0)))
 391        (nnheader-nov-field))            ; Xref
 392      (nnheader-nov-parse-extra))))      ; extra
 393
 394 (defun nnheader-insert-nov (header)
 395   (princ (mail-header-number header) (current-buffer))
 396   (let ((p (point)))
 397     (insert
 398      "\t"
 399      (or (mime-entity-fetch-field header 'Subject) "(none)") "\t"
 400      (or (mime-entity-fetch-field header 'From) "(nobody)") "\t"
 401      (or (mail-header-date header) "") "\t"
 402      (or (mail-header-id header)
 403          (nnmail-message-id))
 404      "\t"
 405      (or (mail-header-references header) "") "\t")
 406     (princ (or (mail-header-chars header) 0) (current-buffer))
 407     (insert "\t")
 408     (princ (or (mail-header-lines header) 0) (current-buffer))
 409     (insert "\t")
 410     (when (mail-header-xref header)
 411       (insert "Xref: " (mail-header-xref header)))
 412     (when (or (mail-header-xref header)
 413               (mail-header-extra header))
 414       (insert "\t"))
 415     (when (mail-header-extra header)
 416       (let ((extra (mail-header-extra header)))
 417         (while extra
 418           (insert (symbol-name (caar extra))
 419                   ": " (cdar extra) "\t")
 420           (pop extra))))
 421     (insert "\n")
 422     (backward-char 1)
 423     (while (search-backward "\n" p t)
 424       (delete-char 1))
 425     (forward-line 1)))
 426
 427 (defun nnheader-insert-header (header)
 428   (insert
 429    "Subject: " (or (mail-header-subject header) "(none)") "\n"
 430    "From: " (or (mail-header-from header) "(nobody)") "\n"
 431    "Date: " (or (mail-header-date header) "") "\n"
 432    "Message-ID: " (or (mail-header-id header) (nnmail-message-id)) "\n"
 433    "References: " (or (mail-header-references header) "") "\n"
 434    "Lines: ")
 435   (princ (or (mail-header-lines header) 0) (current-buffer))
 436   (insert "\n\n"))
 437
 438 (defun nnheader-insert-article-line (article)
 439   (goto-char (point-min))
 440   (insert "220 ")
 441   (princ article (current-buffer))
 442   (insert " Article retrieved.\n")
 443   (search-forward "\n\n" nil 'move)
 444   (delete-region (point) (point-max))
 445   (forward-char -1)
 446   (insert "."))
 447
 448 (defun nnheader-nov-delete-outside-range (beg end)
 449   "Delete all NOV lines that lie outside the BEG to END range."
 450   ;; First we find the first wanted line.
 451   (nnheader-find-nov-line beg)
 452   (delete-region (point-min) (point))
 453   ;; Then we find the last wanted line.
 454   (when (nnheader-find-nov-line end)
 455     (forward-line 1))
 456   (delete-region (point) (point-max)))
 457
 458 (defun nnheader-find-nov-line (article)
 459   "Put point at the NOV line that start with ARTICLE.
 460 If ARTICLE doesn't exist, put point where that line
 461 would have been.  The function will return non-nil if
 462 the line could be found."
 463   ;; This function basically does a binary search.
 464   (let ((max (point-max))
 465         (min (goto-char (point-min)))
 466         (cur (current-buffer))
 467         (prev (point-min))
 468         num found)
 469     (while (not found)
 470       (goto-char (/ (+ max min) 2))
 471       (beginning-of-line)
 472       (if (or (= (point) prev)
 473               (eobp))
 474           (setq found t)
 475         (setq prev (point))
 476         (while (and (not (numberp (setq num (read cur))))
 477                     (not (eobp)))
 478           (delete-region (progn (beginning-of-line) (point))
 479                          (progn (forward-line 1) (point))))
 480         (cond ((> num article)
 481                (setq max (point)))
 482               ((< num article)
 483                (setq min (point)))
 484               (t
 485                (setq found 'yes)))))
 486     ;; We may be at the first line.
 487     (when (and (not num)
 488                (not (eobp)))
 489       (setq num (read cur)))
 490     ;; Now we may have found the article we're looking for, or we
 491     ;; may be somewhere near it.
 492     (when (and (not (eq found 'yes))
 493                (not (eq num article)))
 494       (setq found (point))
 495       (while (and (< (point) max)
 496                   (or (not (numberp num))
 497                       (< num article)))
 498         (forward-line 1)
 499         (setq found (point))
 500         (or (eobp)
 501             (= (setq num (read cur)) article)))
 502       (unless (eq num article)
 503         (goto-char found)))
 504     (beginning-of-line)
 505     (eq num article)))
 506
 507 (defun nnheader-retrieve-headers-from-directory* (articles
 508                                                   directory dependencies
 509                                                   &optional
 510                                                   fetch-old force-new large
 511                                                   backend)
 512   (with-temp-buffer
 513     (let* ((file nil)
 514            (number (length articles))
 515            (count 0)
 516            (file-name-coding-system 'binary)
 517            (pathname-coding-system 'binary)
 518            (case-fold-search t)
 519            (cur (current-buffer))
 520            article
 521            headers header id end ref in-reply-to lines chars ctype)
 522       ;; We don't support fetching by Message-ID.
 523       (if (stringp (car articles))
 524           'headers
 525         (while articles
 526           (when (and (file-exists-p
 527                       (setq file (expand-file-name
 528                                   (int-to-string
 529                                    (setq article (pop articles)))
 530                                   directory)))
 531                      (not (file-directory-p file)))
 532             (erase-buffer)
 533             (nnheader-insert-head file)
 534             (save-restriction
 535               (std11-narrow-to-header)
 536               (setq
 537                header
 538                (make-full-mail-header
 539                 ;; Number.
 540                 article
 541                 ;; Subject.
 542                 (or (std11-fetch-field "Subject")
 543                     "(none)")
 544                 ;; From.
 545                 (or (std11-fetch-field "From")
 546                     "(nobody)")
 547                 ;; Date.
 548                 (or (std11-fetch-field "Date")
 549                     "")
 550                 ;; Message-ID.
 551                 (progn
 552                   (goto-char (point-min))
 553                   (setq id (if (re-search-forward
 554                                 "^Message-ID: *\\(<[^\n\t> ]+>\\)" nil t)
 555                                ;; We do it this way to make sure the Message-ID
 556                                ;; is (somewhat) syntactically valid.
 557                                (buffer-substring (match-beginning 1)
 558                                                  (match-end 1))
 559                              ;; If there was no message-id, we just fake one
 560                              ;; to make subsequent routines simpler.
 561                              (nnheader-generate-fake-message-id))))
 562                 ;; References.
 563                 (progn
 564                   (goto-char (point-min))
 565                   (if (search-forward "\nReferences: " nil t)
 566                       (progn
 567                         (setq end (point))
 568                         (prog1
 569                             (buffer-substring (match-end 0) (std11-field-end))
 570                           (setq ref
 571                                 (buffer-substring
 572                                  (progn
 573                                    ;; (end-of-line)
 574                                    (search-backward ">" end t)
 575                                    (1+ (point)))
 576                                  (progn
 577                                    (search-backward "<" end t)
 578                                    (point))))))
 579                     ;; Get the references from the in-reply-to header if there
 580                     ;; were no references and the in-reply-to header looks
 581                     ;; promising.
 582                     (if (and (search-forward "\nIn-Reply-To: " nil t)
 583                              (setq in-reply-to
 584                                    (buffer-substring (match-end 0)
 585                                                      (std11-field-end)))
 586                              (string-match "<[^>]+>" in-reply-to))
 587                         (let (ref2)
 588                           (setq ref (substring in-reply-to (match-beginning 0)
 589                                                (match-end 0)))
 590                           (while (string-match "<[^>]+>"
 591                                                in-reply-to (match-end 0))
 592                             (setq ref2
 593                                   (substring in-reply-to (match-beginning 0)
 594                                              (match-end 0)))
 595                             (when (> (length ref2) (length ref))
 596                               (setq ref ref2)))
 597                           ref)
 598                       (setq ref nil))))
 599                 ;; Chars.
 600                 (progn
 601                   (goto-char (point-min))
 602                   (if (search-forward "\nChars: " nil t)
 603                       (if (numberp (setq chars (ignore-errors (read cur))))
 604                           chars 0)
 605                     0))
 606                 ;; Lines.
 607                 (progn
 608                   (goto-char (point-min))
 609                   (if (search-forward "\nLines: " nil t)
 610                       (if (numberp (setq lines (ignore-errors (read cur))))
 611                           lines 0)
 612                     0))
 613                 ;; Xref.
 614                 (std11-fetch-field "Xref")
 615                 ))
 616               (goto-char (point-min))
 617               (if (setq ctype (std11-fetch-field "Content-Type"))
 618                   (mime-entity-set-content-type-internal
 619                    header (mime-parse-Content-Type ctype)))
 620               )
 621             (when (setq header
 622                         (gnus-dependencies-add-header
 623                          header dependencies force-new))
 624               (push header headers))
 625             )
 626           (setq count (1+ count))
 627
 628           (and large
 629                (zerop (% count 20))
 630                (nnheader-message 5 "%s: Receiving headers... %d%%"
 631                                  backend
 632                                  (/ (* count 100) number))))
 633
 634         (when large
 635           (nnheader-message 5 "%s: Receiving headers...done" backend))
 636
 637         headers))))
 638
 639 (defun nnheader-retrieve-headers-from-directory (articles
 640                                                  directory dependencies
 641                                                  &optional
 642                                                  fetch-old force-new large
 643                                                  backend)
 644   (cons 'header
 645         (nreverse (nnheader-retrieve-headers-from-directory*
 646                    articles directory dependencies
 647                    fetch-old force-new large backend))))
 648
 649 (defun nnheader-get-newsgroup-headers-xover* (sequence
 650                                               &optional
 651                                               force-new dependencies
 652                                               group)
 653   "Parse the news overview data in the server buffer, and return a
 654 list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
 655   ;; Get the Xref when the users reads the articles since most/some
 656   ;; NNTP servers do not include Xrefs when using XOVER.
 657   ;; (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
 658   (let ((cur nntp-server-buffer)
 659         number headers header)
 660     (save-excursion
 661       (set-buffer nntp-server-buffer)
 662       ;; Allow the user to mangle the headers before parsing them.
 663       (gnus-run-hooks 'gnus-parse-headers-hook)
 664       (goto-char (point-min))
 665       (while (not (eobp))
 666         (condition-case ()
 667             (while (and sequence (not (eobp)))
 668               (setq number (read cur))
 669               (while (and sequence
 670                           (< (car sequence) number))
 671                 (setq sequence (cdr sequence)))
 672               (and sequence
 673                    (eq number (car sequence))
 674                    (progn
 675                      (setq sequence (cdr sequence))
 676                      (setq header (inline
 677                                     (gnus-nov-parse-line
 678                                      number dependencies force-new))))
 679                    (push header headers))
 680               (forward-line 1))
 681           (error
 682            (gnus-error 4 "Strange nov line (%d)"
 683                        (count-lines (point-min) (point)))))
 684         (forward-line 1))
 685       ;; A common bug in inn is that if you have posted an article and
 686       ;; then retrieves the active file, it will answer correctly --
 687       ;; the new article is included.  However, a NOV entry for the
 688       ;; article may not have been generated yet, so this may fail.
 689       ;; We work around this problem by retrieving the last few
 690       ;; headers using HEAD.
 691       headers)))
 692
 693 ;; Various cruft the backends and Gnus need to communicate.
 694
 695 (defvar nntp-server-buffer nil)
 696 (defvar nntp-process-response nil)
 697 (defvar news-reply-yank-from nil)
 698 (defvar news-reply-yank-message-id nil)
 699
 700 (defvar nnheader-callback-function nil)
 701
 702 (defun nnheader-init-server-buffer ()
 703   "Initialize the Gnus-backend communication buffer."
 704   (save-excursion
 705     (unless (gnus-buffer-live-p nntp-server-buffer)
 706       (setq nntp-server-buffer (get-buffer-create " *nntpd*")))
 707     (set-buffer nntp-server-buffer)
 708     (erase-buffer)
 709     (kill-all-local-variables)
 710     (setq case-fold-search t)           ;Should ignore case.
 711     (set (make-local-variable 'nntp-process-response) nil)
 712     t))
 713
 714 ;;; Various functions the backends use.
 715
 716 (defun nnheader-file-error (file)
 717   "Return a string that says what is wrong with FILE."
 718   (format
 719    (cond
 720     ((not (file-exists-p file))
 721      "%s does not exist")
 722     ((file-directory-p file)
 723      "%s is a directory")
 724     ((not (file-readable-p file))
 725      "%s is not readable"))
 726    file))
 727
 728 (defun nnheader-insert-head (file)
 729   "Insert the head of the article."
 730   (when (file-exists-p file)
 731     (if (eq nnheader-max-head-length t)
 732         ;; Just read the entire file.
 733         (nnheader-insert-file-contents file)
 734       ;; Read 1K blocks until we find a separator.
 735       (let ((beg 0)
 736             format-alist)
 737         (while (and (eq nnheader-head-chop-length
 738                         (nth 1 (nnheader-insert-file-contents
 739                                 file nil beg
 740                                 (incf beg nnheader-head-chop-length))))
 741                     (prog1 (not (search-forward "\n\n" nil t))
 742                       (goto-char (point-max)))
 743                     (or (null nnheader-max-head-length)
 744                         (< beg nnheader-max-head-length))))))
 745     t))
 746
 747 (defun nnheader-article-p ()
 748   "Say whether the current buffer looks like an article."
 749   (goto-char (point-min))
 750   (if (not (search-forward "\n\n" nil t))
 751       nil
 752     (narrow-to-region (point-min) (1- (point)))
 753     (goto-char (point-min))
 754     (while (looking-at "[a-zA-Z][^ \t]+:.*\n\\([ \t].*\n\\)*\\|From .*\n")
 755       (goto-char (match-end 0)))
 756     (prog1
 757         (eobp)
 758       (widen))))
 759
 760 (defun nnheader-insert-references (references message-id)
 761   "Insert a References header based on REFERENCES and MESSAGE-ID."
 762   (if (and (not references) (not message-id))
 763       ;; This is invalid, but not all articles have Message-IDs.
 764       ()
 765     (mail-position-on-field "References")
 766     (let ((begin (save-excursion (beginning-of-line) (point)))
 767           (fill-column 78)
 768           (fill-prefix "\t"))
 769       (when references
 770         (insert references))
 771       (when (and references message-id)
 772         (insert " "))
 773       (when message-id
 774         (insert message-id))
 775       ;; Fold long References lines to conform to RFC1036 (sort of).
 776       ;; The region must end with a newline to fill the region
 777       ;; without inserting extra newline.
 778       (fill-region-as-paragraph begin (1+ (point))))))
 779
 780 (defun nnheader-replace-header (header new-value)
 781   "Remove HEADER and insert the NEW-VALUE."
 782   (save-excursion
 783     (save-restriction
 784       (nnheader-narrow-to-headers)
 785       (prog1
 786           (message-remove-header header)
 787         (goto-char (point-max))
 788         (insert header ": " new-value "\n")))))
 789
 790 (defun nnheader-narrow-to-headers ()
 791   "Narrow to the head of an article."
 792   (widen)
 793   (narrow-to-region
 794    (goto-char (point-min))
 795    (if (search-forward "\n\n" nil t)
 796        (1- (point))
 797      (point-max)))
 798   (goto-char (point-min)))
 799
 800 (defun nnheader-set-temp-buffer (name &optional noerase)
 801   "Set-buffer to an empty (possibly new) buffer called NAME with undo disabled."
 802   (set-buffer (get-buffer-create name))
 803   (buffer-disable-undo)
 804   (unless noerase
 805     (erase-buffer))
 806   (current-buffer))
 807
 808 (eval-when-compile (defvar jka-compr-compression-info-list))
 809 (defvar nnheader-numerical-files
 810   (if (boundp 'jka-compr-compression-info-list)
 811       (concat "\\([0-9]+\\)\\("
 812               (mapconcat (lambda (i) (aref i 0))
 813                          jka-compr-compression-info-list "\\|")
 814               "\\)?")
 815     "[0-9]+$")
 816   "Regexp that match numerical files.")
 817
 818 (defvar nnheader-numerical-short-files (concat "^" nnheader-numerical-files)
 819   "Regexp that matches numerical file names.")
 820
 821 (defvar nnheader-numerical-full-files (concat "/" nnheader-numerical-files)
 822   "Regexp that matches numerical full file paths.")
 823
 824 (defsubst nnheader-file-to-number (file)
 825   "Take a FILE name and return the article number."
 826   (if (string= nnheader-numerical-short-files "^[0-9]+$")
 827       (string-to-int file)
 828     (string-match nnheader-numerical-short-files file)
 829     (string-to-int (match-string 0 file))))
 830
 831 (defvar nnheader-directory-files-is-safe
 832   (or (eq system-type 'windows-nt)
 833       (and (not (featurep 'xemacs))
 834            (> emacs-major-version 20)))
 835   "If non-nil, Gnus believes `directory-files' is safe.
 836 It has been reported numerous times that `directory-files' fails with
 837 an alarming frequency on NFS mounted file systems. If it is nil,
 838 `nnheader-directory-files-safe' is used.")
 839
 840 (defun nnheader-directory-files-safe (&rest args)
 841   "Execute `directory-files' twice and returns the longer result."
 842   (let ((first (apply 'directory-files args))
 843         (second (apply 'directory-files args)))
 844     (if (> (length first) (length second))
 845         first
 846       second)))
 847
 848 (defun nnheader-directory-articles (dir)
 849   "Return a list of all article files in directory DIR."
 850   (mapcar 'nnheader-file-to-number
 851           (if nnheader-directory-files-is-safe
 852               (directory-files
 853                dir nil nnheader-numerical-short-files t)
 854             (nnheader-directory-files-safe
 855              dir nil nnheader-numerical-short-files t))))
 856
 857 (defun nnheader-article-to-file-alist (dir)
 858   "Return an alist of article/file pairs in DIR."
 859   (mapcar (lambda (file) (cons (nnheader-file-to-number file) file))
 860           (if nnheader-directory-files-is-safe
 861               (directory-files
 862                dir nil nnheader-numerical-short-files t)
 863             (nnheader-directory-files-safe
 864              dir nil nnheader-numerical-short-files t))))
 865
 866 (defun nnheader-fold-continuation-lines ()
 867   "Fold continuation lines in the current buffer."
 868   (nnheader-replace-regexp "\\(\r?\n[ \t]+\\)+" " "))
 869
 870 (defun nnheader-translate-file-chars (file &optional full)
 871   "Translate FILE into something that can be a file name.
 872 If FULL, translate everything."
 873   (if (null nnheader-file-name-translation-alist)
 874       ;; No translation is necessary.
 875       file
 876     (let* ((i 0)
 877            trans leaf path len)
 878       (if full
 879           ;; Do complete translation.
 880           (setq leaf (copy-sequence file)
 881                 path ""
 882                 i (if (and (< 1 (length leaf)) (eq ?: (aref leaf 1)))
 883                       2 0))
 884         ;; We translate -- but only the file name.  We leave the directory
 885         ;; alone.
 886         (if (and (featurep 'xemacs)
 887                  (memq system-type '(cygwin32 win32 w32 mswindows windows-nt)))
 888             ;; This is needed on NT and stuff, because
 889             ;; file-name-nondirectory is not enough to split
 890             ;; file names, containing ':', e.g.
 891             ;; "d:\\Work\\News\\nntp+news.fido7.ru:fido7.ru.gnu.SCORE"
 892             ;;
 893             ;; we are trying to correctly split such names:
 894             ;; "d:file.name" -> "a:" "file.name"
 895             ;; "aaa:bbb.ccc" -> "" "aaa:bbb.ccc"
 896             ;; "d:aaa\\bbb:ccc"   -> "d:aaa\\" "bbb:ccc"
 897             ;; etc.
 898             ;; to translate then only the file name part.
 899             (progn
 900               (setq leaf file
 901                     path "")
 902               (if (string-match "\\(^\\w:\\|[/\\]\\)\\([^/\\]+\\)$" file)
 903                   (setq leaf (substring file (match-beginning 2))
 904                         path (substring file 0 (match-beginning 2)))))
 905           ;; Emacs DTRT, says andrewi.
 906           (setq leaf (file-name-nondirectory file)
 907                 path (file-name-directory file))))
 908       (setq len (length leaf))
 909       (while (< i len)
 910         (when (setq trans (cdr (assq (aref leaf i)
 911                                      nnheader-file-name-translation-alist)))
 912           (aset leaf i trans))
 913         (incf i))
 914       (concat path leaf))))
 915
 916 (defun nnheader-report (backend &rest args)
 917   "Report an error from the BACKEND.
 918 The first string in ARGS can be a format string."
 919   (set (intern (format "%s-status-string" backend))
 920        (if (< (length args) 2)
 921            (car args)
 922          (apply 'format args)))
 923   nil)
 924
 925 (defun nnheader-get-report (backend)
 926   "Get the most recent report from BACKEND."
 927   (condition-case ()
 928       (nnheader-message 5 "%s" (symbol-value (intern (format "%s-status-string"
 929                                                              backend))))
 930     (error (nnheader-message 5 ""))))
 931
 932 (defun nnheader-insert (format &rest args)
 933   "Clear the communication buffer and insert FORMAT and ARGS into the buffer.
 934 If FORMAT isn't a format string, it and all ARGS will be inserted
 935 without formatting."
 936   (save-excursion
 937     (set-buffer nntp-server-buffer)
 938     (erase-buffer)
 939     (if (string-match "%" format)
 940         (insert (apply 'format format args))
 941       (apply 'insert format args))
 942     t))
 943
 944 (static-if (fboundp 'subst-char-in-string)
 945     (defsubst nnheader-replace-chars-in-string (string from to)
 946       (subst-char-in-string from to string))
 947   (defun nnheader-replace-chars-in-string (string from to)
 948     "Replace characters in STRING from FROM to TO."
 949     (let ((string (substring string 0)) ;Copy string.
 950           (len (length string))
 951           (idx 0))
 952       ;; Replace all occurrences of FROM with TO.
 953       (while (< idx len)
 954         (when (= (aref string idx) from)
 955           (aset string idx to))
 956         (setq idx (1+ idx)))
 957       string)))
 958
 959 (defun nnheader-replace-duplicate-chars-in-string (string from to)
 960   "Replace characters in STRING from FROM to TO."
 961   (let ((string (substring string 0))   ;Copy string.
 962         (len (length string))
 963         (idx 0) prev i)
 964     ;; Replace all occurrences of FROM with TO.
 965     (while (< idx len)
 966       (setq i (aref string idx))
 967       (when (and (eq prev from) (= i from))
 968         (aset string (1- idx) to)
 969         (aset string idx to))
 970       (setq prev i)
 971       (setq idx (1+ idx)))
 972     string))
 973
 974 (defun nnheader-file-to-group (file &optional top)
 975   "Return a group name based on FILE and TOP."
 976   (nnheader-replace-chars-in-string
 977    (if (not top)
 978        file
 979      (condition-case ()
 980          (substring (expand-file-name file)
 981                     (length
 982                      (expand-file-name
 983                       (file-name-as-directory top))))
 984        (error "")))
 985    ?/ ?.))
 986
 987 (defun nnheader-message (level &rest args)
 988   "Message if the Gnus backends are talkative."
 989   (if (or (not (numberp gnus-verbose-backends))
 990           (<= level gnus-verbose-backends))
 991       (apply 'message args)
 992     (apply 'format args)))
 993
 994 (defun nnheader-be-verbose (level)
 995   "Return whether the backends should be verbose on LEVEL."
 996   (or (not (numberp gnus-verbose-backends))
 997       (<= level gnus-verbose-backends)))
 998
 999 (defvar nnheader-pathname-coding-system 'binary
1000   "*Coding system for pathname.")
1001
1002 (defun nnheader-group-pathname (group dir &optional file)
1003   "Make pathname for GROUP."
1004   (concat
1005    (let ((dir (file-name-as-directory (expand-file-name dir))))
1006      ;; If this directory exists, we use it directly.
1007      (file-name-as-directory
1008       (if (file-directory-p (concat dir group))
1009           (expand-file-name group dir)
1010         ;; If not, we translate dots into slashes.
1011         (expand-file-name (encode-coding-string
1012                            (nnheader-replace-chars-in-string group ?. ?/)
1013                            nnheader-pathname-coding-system)
1014                           dir))))
1015    (cond ((null file) "")
1016          ((numberp file) (int-to-string file))
1017          (t file))))
1018
1019 (defun nnheader-functionp (form)
1020   "Return non-nil if FORM is funcallable."
1021   (or (and (symbolp form) (fboundp form))
1022       (and (listp form) (eq (car form) 'lambda))))
1023
1024 (defun nnheader-concat (dir &rest files)
1025   "Concat DIR as directory to FILES."
1026   (apply 'concat (file-name-as-directory dir) files))
1027
1028 (defun nnheader-ms-strip-cr ()
1029   "Strip ^M from the end of all lines."
1030   (save-excursion
1031     (goto-char (point-min))
1032     (while (re-search-forward "\r$" nil t)
1033       (delete-backward-char 1))))
1034
1035 (defun nnheader-file-size (file)
1036   "Return the file size of FILE or 0."
1037   (or (nth 7 (file-attributes file)) 0))
1038
1039 (defun nnheader-find-etc-directory (package &optional file)
1040   "Go through the path and find the \".../etc/PACKAGE\" directory.
1041 If FILE, find the \".../etc/PACKAGE\" file instead."
1042   (let ((path load-path)
1043         dir result)
1044     ;; We try to find the dir by looking at the load path,
1045     ;; stripping away the last component and adding "etc/".
1046     (while path
1047       (if (and (car path)
1048                (file-exists-p
1049                 (setq dir (concat
1050                            (file-name-directory
1051                             (directory-file-name (car path)))
1052                            "etc/" package
1053                            (if file "" "/"))))
1054                (or file (file-directory-p dir)))
1055           (setq result dir
1056                 path nil)
1057         (setq path (cdr path))))
1058     result))
1059
1060 (eval-when-compile
1061   (defvar ange-ftp-path-format)
1062   (defvar efs-path-regexp))
1063 (defun nnheader-re-read-dir (path)
1064   "Re-read directory PATH if PATH is on a remote system."
1065   (if (and (fboundp 'efs-re-read-dir) (boundp 'efs-path-regexp))
1066       (when (string-match efs-path-regexp path)
1067         (efs-re-read-dir path))
1068     (when (and (fboundp 'ange-ftp-re-read-dir) (boundp 'ange-ftp-path-format))
1069       (when (string-match (car ange-ftp-path-format) path)
1070         (ange-ftp-re-read-dir path)))))
1071
1072 (defvar nnheader-file-coding-system 'raw-text
1073   "Coding system used in file backends of Gnus.")
1074
1075 (defun nnheader-insert-file-contents (filename &optional visit beg end replace)
1076   "Like `insert-file-contents', q.v., but only reads in the file.
1077 A buffer may be modified in several ways after reading into the buffer due
1078 to advanced Emacs features, such as file-name-handlers, format decoding,
1079 find-file-hooks, etc.
1080   This function ensures that none of these modifications will take place."
1081   (let ((format-alist nil)
1082         (auto-mode-alist (nnheader-auto-mode-alist))
1083         (default-major-mode 'fundamental-mode)
1084         (enable-local-variables nil)
1085         (after-insert-file-functions nil)
1086         (enable-local-eval nil)
1087         (find-file-hooks nil))
1088     (insert-file-contents-as-coding-system
1089      nnheader-file-coding-system filename visit beg end replace)))
1090
1091 (defun nnheader-find-file-noselect (&rest args)
1092   (let ((format-alist nil)
1093         (auto-mode-alist (nnheader-auto-mode-alist))
1094         (default-major-mode 'fundamental-mode)
1095         (enable-local-variables nil)
1096         (after-insert-file-functions nil)
1097         (enable-local-eval nil)
1098         (find-file-hooks nil))
1099     (apply 'find-file-noselect-as-coding-system
1100            nnheader-file-coding-system args)))
1101
1102 (defun nnheader-auto-mode-alist ()
1103   "Return an `auto-mode-alist' with only the .gz (etc) thingies."
1104   (let ((alist auto-mode-alist)
1105         out)
1106     (while alist
1107       (when (listp (cdar alist))
1108         (push (car alist) out))
1109       (pop alist))
1110     (nreverse out)))
1111
1112 (defun nnheader-directory-regular-files (dir)
1113   "Return a list of all regular files in DIR."
1114   (let ((files (directory-files dir t))
1115         out)
1116     (while files
1117       (when (file-regular-p (car files))
1118         (push (car files) out))
1119       (pop files))
1120     (nreverse out)))
1121
1122 (defun nnheader-directory-files (&rest args)
1123   "Same as `directory-files', but prune \".\" and \"..\"."
1124   (let ((files (apply 'directory-files args))
1125         out)
1126     (while files
1127       (unless (member (file-name-nondirectory (car files)) '("." ".."))
1128         (push (car files) out))
1129       (pop files))
1130     (nreverse out)))
1131
1132 (defmacro nnheader-skeleton-replace (from &optional to regexp)
1133   `(let ((new (generate-new-buffer " *nnheader replace*"))
1134          (cur (current-buffer))
1135          (start (point-min)))
1136      (set-buffer cur)
1137      (goto-char (point-min))
1138      (while (,(if regexp 're-search-forward 'search-forward)
1139              ,from nil t)
1140        (insert-buffer-substring
1141         cur start (prog1 (match-beginning 0) (set-buffer new)))
1142        (goto-char (point-max))
1143        ,(when to `(insert ,to))
1144        (set-buffer cur)
1145        (setq start (point)))
1146      (insert-buffer-substring
1147       cur start (prog1 (point-max) (set-buffer new)))
1148      (copy-to-buffer cur (point-min) (point-max))
1149      (kill-buffer (current-buffer))
1150      (set-buffer cur)))
1151
1152 (defun nnheader-replace-string (from to)
1153   "Do a fast replacement of FROM to TO from point to `point-max'."
1154   (nnheader-skeleton-replace from to))
1155
1156 (defun nnheader-replace-regexp (from to)
1157   "Do a fast regexp replacement of FROM to TO from point to `point-max'."
1158   (nnheader-skeleton-replace from to t))
1159
1160 (defun nnheader-strip-cr ()
1161   "Strip all \r's from the current buffer."
1162   (nnheader-skeleton-replace "\r"))
1163
1164 (defalias 'nnheader-run-at-time 'run-at-time)
1165 (defalias 'nnheader-cancel-timer 'cancel-timer)
1166 (defalias 'nnheader-cancel-function-timers 'cancel-function-timers)
1167 (defalias 'nnheader-string-as-multibyte 'string-as-multibyte)
1168
1169 (defun nnheader-Y-or-n-p (prompt)
1170   "Ask user a \"Y/n\" question. Return t if answer is neither \"n\", \"N\" nor \"C-g\"."
1171   (let ((cursor-in-echo-area t)
1172         (echo-keystrokes 0)
1173         (inhibit-quit t)
1174         ans)
1175     (let (message-log-max)
1176       (while (not (memq ans '(?\  ?N ?Y ?\C-g ?\e ?\n ?\r ?n ?y)))
1177         (message "%s(Y/n) " prompt)
1178         (setq ans (read-char-exclusive))))
1179     (if (memq ans '(?\C-g ?N ?n))
1180         (progn
1181           (message "%s(Y/n) No" prompt)
1182           nil)
1183       (message "%s(Y/n) Yes" prompt)
1184       t)))
1185
1186 ;; mm- stuff.
1187 (unless (featurep 'mm-util)
1188   (defun nnheader-image-load-path (&optional package)
1189     (let (dir result)
1190       (dolist (path load-path (nreverse result))
1191         (if (file-directory-p
1192              (setq dir (concat (file-name-directory
1193                                 (directory-file-name path))
1194                                "etc/" (or package "gnus/"))))
1195             (push dir result))
1196         (push path result))))
1197   (defalias 'mm-image-load-path 'nnheader-image-load-path)
1198
1199   (defalias 'mm-read-coding-system
1200     (if (or (and (featurep 'xemacs)
1201                  (<= (string-to-number emacs-version) 21.1))
1202             (boundp 'MULE))
1203         (lambda (prompt &optional default-coding-system)
1204           (read-coding-system prompt))
1205       'read-coding-system))
1206
1207   (defalias 'mm-multibyte-string-p
1208     (if (fboundp 'multibyte-string-p)
1209         'multibyte-string-p
1210       'ignore)))
1211
1212 ;; mail-parse stuff.
1213 (unless (featurep 'mail-parse)
1214   (defun-maybe std11-narrow-to-field ()
1215     "Narrow the buffer to the header on the current line."
1216     (forward-line 0)
1217     (narrow-to-region (point)
1218                       (progn
1219                         (std11-field-end)
1220                         (when (eolp) (forward-line 1))
1221                         (point)))
1222     (goto-char (point-min)))
1223
1224   (defalias 'mail-header-narrow-to-field 'std11-narrow-to-field)
1225
1226   (defalias 'mail-narrow-to-head 'std11-narrow-to-header)
1227
1228   (defun-maybe std11-fold-field ()
1229     "Fold the current line."
1230     (save-excursion
1231       (save-restriction
1232         (std11-narrow-to-field)
1233         (let ((str (std11-unfold-string
1234                     (buffer-substring (point-min) (point-max)))))
1235           (delete-region (point-min) (point-max))
1236           (insert str)))))
1237
1238   (defalias 'mail-header-fold-field 'std11-fold-field)
1239
1240   (defun-maybe std11-extract-addresses-components (string)
1241     "Extract a list of full name and canonical address from STRING.  Each
1242 element looks like a list of the form (FULL-NAME CANONICAL-ADDRESS).
1243 If no name can be extracted, FULL-NAME will be nil."
1244     (when string
1245       (mapcar (function
1246                (lambda (structure)
1247                  (list (std11-full-name-string structure)
1248                        (std11-address-string structure))))
1249               (std11-parse-addresses-string (std11-unfold-string string)))))
1250
1251   (defun mail-header-parse-addresses (string)
1252     "Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs."
1253     (mapcar (function
1254              (lambda (components)
1255                (cons (nth 1 components) (car components))))
1256             (std11-extract-addresses-components string)))
1257
1258   (defun-maybe std11-field-value (&optional dont-include-last-newline)
1259     "Return the value of the field at point.  If the optional argument is
1260 given, the return value will not contain the last newline."
1261     (let ((begin (point))
1262           (inhibit-point-motion-hooks t)
1263           start value)
1264       (beginning-of-line)
1265       (unless (eobp)
1266         (while (and (memq (char-after) '(?\t ?\ ))
1267                     (zerop (forward-line -1))))
1268         (when (looking-at ".+:[\t\n ]+")
1269           (goto-char (setq start (match-end 0)))
1270           (forward-line 1)
1271           (while (and (memq (char-after) '(?\t ?\ ))
1272                       (zerop (forward-line 1))))
1273           (when dont-include-last-newline
1274             (skip-chars-backward "\t\n " start))
1275           (setq value (buffer-substring start (point)))))
1276       (goto-char begin)
1277       value))
1278
1279   (defalias 'mail-header-field-value 'std11-field-value))
1280
1281 (when (featurep 'xemacs)
1282   (require 'nnheaderxm))
1283
1284 (run-hooks 'nnheader-load-hook)
1285
1286 (provide 'nnheader)
1287
1288 ;;; nnheader.el ends here