* gnus-art.el (gnus-article-reply-with-original): New command.

[gnus] / lisp / gnus-spec.el

diff --git a/lisp/gnus-spec.el b/lisp/gnus-spec.el
index a15490e..92a9e80 100644 (file)
--- a/lisp/gnus-spec.el
+++ b/lisp/gnus-spec.el
@@ -1,5 +1,5 @@
-;;; gnus-spec.el --- format spec functions for Gnus  -*- coding: iso-latin-1 -*-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;;; gnus-spec.el --- format spec functions for Gnus
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001
 ;;        Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -382,47 +382,53 @@ characters when given a pad value."
       (gnus-parse-simple-format format spec-alist insert))))
 
 (defun gnus-parse-complex-format (format spec-alist)
-  (save-excursion
-    (gnus-set-work-buffer)
-    (insert format)
-    (goto-char (point-min))
-    (while (re-search-forward "\"" nil t)
-      (replace-match "\\\"" nil t))
-    (goto-char (point-min))
-    (insert "(\"")
-    ;; Convert all font specs into font spec lists.
-    (while (re-search-forward "%\\([0-9]+\\)?\\([«»{}()]\\)" nil t)
-      (let ((number (if (match-beginning 1)
-                       (match-string 1) "0"))
-           (delim (aref (match-string 2) 0)))
-       (if (or (= delim ?\()
-               (= delim ?\{)
-               (= delim ?\«))
-           (replace-match (concat "\"("
-                                  (cond ((= delim ?\() "mouse")
-                                        ((= delim ?\{) "face")
-                                        (t "balloon"))
-                                  " " number " \"")
-                          t t)
-         (replace-match "\")\""))))
-    (goto-char (point-max))
-    (insert "\")")
-    ;; Convert point position commands.
-    (goto-char (point-min))
-    (let ((case-fold-search nil))
-      (while (re-search-forward "%\\([-0-9]+\\)?C" nil t)
-       (replace-match "\"(point)\"" t t)))
-    ;; Convert TAB commands.
-    (goto-char (point-min))
-    (while (re-search-forward "%\\([-0-9]+\\)=" nil t)
-      (replace-match (format "\"(tab %s)\"" (match-string 1)) t t))
-    ;; Convert the buffer into the spec.
-    (goto-char (point-min))
-    (let ((form (read (current-buffer))))
-      ;; If the first element is '(point), we just remove it.
-      (when (equal (car form) '(point))
-       (pop form))
-      (cons 'progn (gnus-complex-form-to-spec form spec-alist)))))
+  (let (found-C)
+    (save-excursion
+      (gnus-set-work-buffer)
+      (insert format)
+      (goto-char (point-min))
+      (while (re-search-forward "\"" nil t)
+       (replace-match "\\\"" nil t))
+      (goto-char (point-min))
+      (insert "(\"")
+      ;; Convert all font specs into font spec lists.
+      (while (re-search-forward "%\\([0-9]+\\)?\\([«»{}()]\\)" nil t)
+       (let ((number (if (match-beginning 1)
+                         (match-string 1) "0"))
+             (delim (aref (match-string 2) 0)))
+         (if (or (= delim ?\()
+                 (= delim ?\{)
+                 (= delim ?\«))
+             (replace-match (concat "\"("
+                                    (cond ((= delim ?\() "mouse")
+                                          ((= delim ?\{) "face")
+                                          (t "balloon"))
+                                    " " number " \"")
+                            t t)
+           (replace-match "\")\""))))
+      (goto-char (point-max))
+      (insert "\")")
+      ;; Convert point position commands.
+      (goto-char (point-min))
+      (let ((case-fold-search nil))
+       (while (re-search-forward "%\\([-0-9]+\\)?C" nil t)
+         (replace-match "\"(point)\"" t t)
+         (setq found-C t)))
+      ;; Convert TAB commands.
+      (goto-char (point-min))
+      (while (re-search-forward "%\\([-0-9]+\\)=" nil t)
+       (replace-match (format "\"(tab %s)\"" (match-string 1)) t t))
+      ;; Convert the buffer into the spec.
+      (goto-char (point-min))
+      (let ((form (read (current-buffer))))
+       (if found-C
+           `(let (gnus-position)
+              ,@(gnus-complex-form-to-spec form spec-alist)
+              (if gnus-position
+                  (gnus-put-text-property gnus-position (1+ gnus-position) 
+                                          'gnus-position t)))
+         `(progn
+            ,@(gnus-complex-form-to-spec form spec-alist)))))))
 
 (defun gnus-complex-form-to-spec (form spec-alist)
   (delq nil
@@ -432,7 +438,7 @@ characters when given a pad value."
            ((stringp sform)
             (gnus-parse-simple-format sform spec-alist t))
            ((eq (car sform) 'point)
-            `(gnus-put-text-property (1- (point)) (point) 'gnus-position t))
+            '(setq gnus-position (point)))
            ((eq (car sform) 'tab)
             (gnus-spec-tab (cadr sform)))
            (t
@@ -448,7 +454,7 @@ characters when given a pad value."
   (let ((max-width 0)
        spec flist fstring elem result dontinsert user-defined
        type value pad-width spec-beg cut-width ignore-value
-       tilde-form tilde elem-type)
+       tilde-form tilde elem-type extended-spec)
     (save-excursion
       (gnus-set-work-buffer)
       (insert format)
@@ -460,7 +466,8 @@ characters when given a pad value."
              max-width nil
              cut-width nil
              ignore-value nil
-             tilde-form nil)
+             tilde-form nil
+             extended-spec nil)
        (setq spec-beg (1- (point)))
 
        ;; Parse this spec fully.
@@ -501,10 +508,18 @@ characters when given a pad value."
              t)
             (t
              nil)))
-       ;; User-defined spec -- find the spec name.
-       (when (eq (setq spec (char-after)) ?u)
+       (cond 
+        ;; User-defined spec -- find the spec name.
+        ((eq (setq spec (char-after)) ?u)
          (forward-char 1)
-         (setq user-defined (char-after)))
+         (when (and (eq (setq user-defined (char-after)) ?&)
+                    (looking-at "&\\([^;]+\\);"))
+           (setq user-defined (match-string 1))
+           (goto-char (match-end 1))))
+        ;; extended spec
+        ((and (eq spec ?&) (looking-at "&\\([^;]+\\);"))
+         (setq extended-spec (intern (match-string 1)))
+         (goto-char (match-end 1))))
        (forward-char 1)
        (delete-region spec-beg (point))
 
@@ -522,12 +537,15 @@ characters when given a pad value."
           (user-defined
            (setq elem
                  (list
-                  (list (intern (format "gnus-user-format-function-%c"
-                                        user-defined))
+                  (list (intern (format 
+                                 (if (stringp user-defined)
+                                     "gnus-user-format-function-%s"
+                                   "gnus-user-format-function-%c")
+                                 user-defined))
                         'gnus-tmp-header)
                   ?s)))
           ;; Find the specification from `spec-alist'.
-          ((setq elem (cdr (assq spec spec-alist))))
+          ((setq elem (cdr (assq (or extended-spec spec) spec-alist))))
           (t
            (setq elem '("*" ?s))))
          (setq elem-type (cadr elem))
@@ -558,13 +576,13 @@ characters when given a pad value."
                  (push el flist)))
            (insert elem-type)
            (push (car elem) flist))))
-      (setq fstring (buffer-string)))
+      (setq fstring (buffer-substring-no-properties (point-min) (point-max))))
 
     ;; Do some postprocessing to increase efficiency.
     (setq
      result
      (cond
-      ;; Emptyness.
+      ;; Emptiness.
       ((string= fstring "")
        nil)
       ;; Not a format string.