X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fietf-drums.el;h=9c79e9112527878becfbd241c2ba72f96a703fbe;hb=9b741e050b400987d68ff761c6cc3276c932839c;hp=865ddffaaccd3ba96fd28613e963f1b4db04a3c1;hpb=29f03d9b1170ef03842cbc1b674e50ce1eb059db;p=elisp%2Fgnus.git- diff --git a/lisp/ietf-drums.el b/lisp/ietf-drums.el index 865ddff..9c79e91 100644 --- a/lisp/ietf-drums.el +++ b/lisp/ietf-drums.el @@ -1,5 +1,6 @@ ;;; ietf-drums.el --- Functions for parsing RFC822bis headers -;; Copyright (C) 1998 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; This file is part of GNU Emacs. @@ -28,6 +29,7 @@ ;;; Code: +(eval-when-compile (require 'cl)) (require 'time-date) (require 'mm-util) @@ -65,6 +67,11 @@ (modify-syntax-entry ?* " " table) (modify-syntax-entry ?\; " " table) (modify-syntax-entry ?\' " " table) + (if (featurep 'xemacs) + (let ((i 128)) + (while (< i 256) + (modify-syntax-entry i "w" table) + (setq i (1+ i))))) table)) (defun ietf-drums-token-to-list (token) @@ -87,6 +94,8 @@ ((= i (length token)) (push (mm-make-char 'ascii c) out)) (t + (when b + (push (mm-make-char 'ascii b) out)) (setq b c)))) (nreverse out))) @@ -113,7 +122,7 @@ (buffer-string)))) (defun ietf-drums-remove-whitespace (string) - "Remove comments from STRING." + "Remove whitespace from STRING." (with-temp-buffer (ietf-drums-init string) (let (c) @@ -149,6 +158,10 @@ (forward-char 1)))) result))) +(defun ietf-drums-strip (string) + "Remove comments and whitespace from STRING." + (ietf-drums-remove-whitespace (ietf-drums-remove-comments string))) + (defun ietf-drums-parse-address (string) "Parse STRING and return a MAILBOX / DISPLAY-NAME pair." (with-temp-buffer @@ -191,25 +204,38 @@ (defun ietf-drums-parse-addresses (string) "Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs." - (with-temp-buffer - (ietf-drums-init string) - (let ((beg (point)) - pairs c) - (while (not (eobp)) - (setq c (char-after)) - (cond - ((memq c '(?\" ?< ?\()) - (forward-sexp 1)) - ((eq c ?,) - (push (ietf-drums-parse-address (buffer-substring beg (point))) - pairs) - (forward-char 1) - (setq beg (point))) - (t - (forward-char 1)))) - (push (ietf-drums-parse-address (buffer-substring beg (point))) - pairs) - (nreverse pairs)))) + (if (null string) + nil + (with-temp-buffer + (ietf-drums-init string) + (let ((beg (point)) + pairs c address) + (while (not (eobp)) + (setq c (char-after)) + (cond + ((memq c '(?\" ?< ?\()) + (condition-case nil + (forward-sexp 1) + (error + (skip-chars-forward "^,")))) + ((eq c ?,) + (setq address + (condition-case nil + (ietf-drums-parse-address + (buffer-substring beg (point))) + (error nil))) + (if address (push address pairs)) + (forward-char 1) + (setq beg (point))) + (t + (forward-char 1)))) + (setq address + (condition-case nil + (ietf-drums-parse-address + (buffer-substring beg (point))) + (error nil))) + (if address (push address pairs)) + (nreverse pairs))))) (defun ietf-drums-unfold-fws () "Unfold folding white space in the current buffer." @@ -226,8 +252,8 @@ "Narrow to the header section in the current buffer." (narrow-to-region (goto-char (point-min)) - (if (re-search-forward "^\n" nil 1) - (1- (point)) + (if (re-search-forward "^\r?$" nil 1) + (match-beginning 0) (point-max))) (goto-char (point-min)))