X-Git-Url: https://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fietf-drums.el;h=c0e1542fa823480536910494fcc1e5c88a8647bc;hp=7534090dfebb10bc90565260b935cf7aca8cd907;hb=HEAD;hpb=20bc985a3232ebba106d335afcfd6b596bb8efba diff --git a/lisp/ietf-drums.el b/lisp/ietf-drums.el index 7534090df..c0e1542fa 100644 --- a/lisp/ietf-drums.el +++ b/lisp/ietf-drums.el @@ -1,24 +1,22 @@ ;;; ietf-drums.el --- Functions for parsing RFC822bis headers -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004 -;; Free Software Foundation, Inc. + +;; Copyright (C) 1998-2016 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -40,7 +38,6 @@ ;;; Code: (eval-when-compile (require 'cl)) -(require 'time-date) (require 'mm-util) (defvar ietf-drums-no-ws-ctl-token "\001-\010\013\014\016-\037\177" @@ -124,9 +121,18 @@ backslash and doublequote.") (setq c (char-after)) (cond ((eq c ?\") - (forward-sexp 1)) + (condition-case nil + (forward-sexp 1) + (error (goto-char (point-max))))) ((eq c ?\() - (delete-region (point) (progn (forward-sexp 1) (point)))) + (delete-region + (point) + (condition-case nil + (with-syntax-table (copy-syntax-table ietf-drums-syntax-table) + (modify-syntax-entry ?\" "w") + (forward-sexp 1) + (point)) + (error (point-max))))) (t (forward-char 1)))) (buffer-string)))) @@ -199,21 +205,25 @@ backslash and doublequote.") (buffer-substring (1+ (point)) (progn (forward-sexp 1) (1- (point)))))))) - (t (error "Unknown symbol: %c" c)))) + (t + (forward-char 1)))) ;; If we found no display-name, then we look for comments. (if display-name (setq display-string (mapconcat 'identity (reverse display-name) " ")) (setq display-string (ietf-drums-get-comment string))) (if (not mailbox) - (when (string-match "@" display-string) + (when (and display-string + (string-match "@" display-string)) (cons (mapconcat 'identity (nreverse display-name) "") (ietf-drums-get-comment string))) (cons mailbox display-string))))) -(defun ietf-drums-parse-addresses (string) - "Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs." +(defun ietf-drums-parse-addresses (string &optional rawp) + "Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs. +If RAWP, don't actually parse the addresses, but instead return +a list of address strings." (if (null string) nil (with-temp-buffer @@ -230,20 +240,24 @@ backslash and doublequote.") (skip-chars-forward "^,")))) ((eq c ?,) (setq address - (condition-case nil - (ietf-drums-parse-address - (buffer-substring beg (point))) - (error nil))) + (if rawp + (buffer-substring beg (point)) + (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 rawp + (buffer-substring beg (point)) + (condition-case nil + (ietf-drums-parse-address + (buffer-substring beg (point))) + (error nil)))) (if address (push address pairs)) (nreverse pairs))))) @@ -280,5 +294,4 @@ backslash and doublequote.") (provide 'ietf-drums) -;;; arch-tag: 379a0191-dbae-4ca6-a0f5-d4202c209ef9 ;;; ietf-drums.el ends here