emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] Changes to emacs/lisp/gnus/gnus-spec.el


From: Miles Bader
Subject: [Emacs-diffs] Changes to emacs/lisp/gnus/gnus-spec.el
Date: Sat, 04 Sep 2004 09:51:46 -0400

Index: emacs/lisp/gnus/gnus-spec.el
diff -c emacs/lisp/gnus/gnus-spec.el:1.6 emacs/lisp/gnus/gnus-spec.el:1.7
*** emacs/lisp/gnus/gnus-spec.el:1.6    Mon Sep  1 15:45:24 2003
--- emacs/lisp/gnus/gnus-spec.el        Sat Sep  4 13:13:43 2004
***************
*** 1,5 ****
! ;;; gnus-spec.el --- format spec functions for Gnus  -*- coding: iso-latin-1 
-*-
! ;; Copyright (C) 1996, 1997, 1998, 1999, 2000
  ;;        Free Software Foundation, Inc.
  
  ;; Author: Lars Magne Ingebrigtsen <address@hidden>
--- 1,5 ----
! ;;; gnus-spec.el --- format spec functions for Gnus
! ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
  ;;        Free Software Foundation, Inc.
  
  ;; Author: Lars Magne Ingebrigtsen <address@hidden>
***************
*** 30,35 ****
--- 30,46 ----
  
  (require 'gnus)
  
+ (defcustom gnus-use-correct-string-widths (featurep 'xemacs)
+   "*If non-nil, use correct functions for dealing with wide characters."
+   :group 'gnus-format
+   :type 'boolean)
+ 
+ (defcustom gnus-make-format-preserve-properties (featurep 'xemacs)
+   "*If non-nil, use a replacement `format' function which preserves
+ text properties. This is only needed on XEmacs, as FSF Emacs does this 
anyway."
+   :group 'gnus-format
+   :type 'boolean)
+ 
  ;;; Internal variables.
  
  (defvar gnus-summary-mark-positions nil)
***************
*** 69,74 ****
--- 80,87 ----
  (defvar gnus-tmp-article-number)
  (defvar gnus-mouse-face)
  (defvar gnus-mouse-face-prop)
+ (defvar gnus-tmp-header)
+ (defvar gnus-tmp-from)
  
  (defun gnus-summary-line-format-spec ()
    (insert gnus-tmp-unread gnus-tmp-replied
***************
*** 77,89 ****
     (point)
     (progn
       (insert
!       gnus-tmp-opening-bracket
!       (format "%4d: %-20s"
!             gnus-tmp-lines
!             (if (> (length gnus-tmp-name) 20)
!                 (substring gnus-tmp-name 0 20)
!               gnus-tmp-name))
!       gnus-tmp-closing-bracket)
       (point))
     gnus-mouse-face-prop gnus-mouse-face)
    (insert " " gnus-tmp-subject-or-nil "\n"))
--- 90,104 ----
     (point)
     (progn
       (insert
!       (format "%c%4s: %-23s%c" gnus-tmp-opening-bracket gnus-tmp-lines
!             (let ((val
!                    (inline
!                      (gnus-summary-from-or-to-or-newsgroups
!                       gnus-tmp-header gnus-tmp-from))))
!               (if (> (length val) 23)
!                   (substring val 0 23)
!                 val))
!             gnus-tmp-closing-bracket))
       (point))
     gnus-mouse-face-prop gnus-mouse-face)
    (insert " " gnus-tmp-subject-or-nil "\n"))
***************
*** 120,137 ****
  
  (defvar gnus-format-specs
    `((version . ,emacs-version)
      (group "%M\%S\%p\%P\%5y: %(%g%)%l\n" ,gnus-group-line-format-spec)
      (summary-dummy "*  %(:                          :%) %S\n"
                   ,gnus-summary-dummy-line-format-spec)
!     (summary "%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n"
             ,gnus-summary-line-format-spec))
    "Alist of format specs.")
  
  (defvar gnus-article-mode-line-format-spec nil)
  (defvar gnus-summary-mode-line-format-spec nil)
  (defvar gnus-group-mode-line-format-spec nil)
  
! ;;; Phew.  All that gruft is over, fortunately.
  
  ;;;###autoload
  (defun gnus-update-format (var)
--- 135,155 ----
  
  (defvar gnus-format-specs
    `((version . ,emacs-version)
+     (gnus-version . ,(gnus-continuum-version))
      (group "%M\%S\%p\%P\%5y: %(%g%)%l\n" ,gnus-group-line-format-spec)
      (summary-dummy "*  %(:                          :%) %S\n"
                   ,gnus-summary-dummy-line-format-spec)
!     (summary "%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n"
             ,gnus-summary-line-format-spec))
    "Alist of format specs.")
  
+ (defvar gnus-default-format-specs gnus-format-specs)
+ 
  (defvar gnus-article-mode-line-format-spec nil)
  (defvar gnus-summary-mode-line-format-spec nil)
  (defvar gnus-group-mode-line-format-spec nil)
  
! ;;; Phew.  All that gruft is over with, fortunately.
  
  ;;;###autoload
  (defun gnus-update-format (var)
***************
*** 162,174 ****
      (pop-to-buffer "*Gnus Format*")
      (erase-buffer)
      (lisp-interaction-mode)
!     (insert (pp-to-string spec))))
  
  (defun gnus-update-format-specifications (&optional force &rest types)
    "Update all (necessary) format specifications."
    ;; Make the indentation array.
    ;; See whether all the stored info needs to be flushed.
    (when (or force
            (not (equal emacs-version
                        (cdr (assq 'version gnus-format-specs)))))
      (setq gnus-format-specs nil))
--- 180,195 ----
      (pop-to-buffer "*Gnus Format*")
      (erase-buffer)
      (lisp-interaction-mode)
!     (insert (gnus-pp-to-string spec))))
  
  (defun gnus-update-format-specifications (&optional force &rest types)
    "Update all (necessary) format specifications."
    ;; Make the indentation array.
    ;; See whether all the stored info needs to be flushed.
    (when (or force
+           (not gnus-newsrc-file-version)
+           (not (equal (gnus-continuum-version)
+                       (gnus-continuum-version gnus-newsrc-file-version)))
            (not (equal emacs-version
                        (cdr (assq 'version gnus-format-specs)))))
      (setq gnus-format-specs nil))
***************
*** 176,183 ****
    ;; Go through all the formats and see whether they need updating.
    (let (new-format entry type val)
      (while (setq type (pop types))
!       ;; Jump to the proper buffer to find out the value of
!       ;; the variable, if possible.  (It may be buffer-local.)
        (save-excursion
        (let ((buffer (intern (format "gnus-%s-buffer" type)))
              val)
--- 197,204 ----
    ;; Go through all the formats and see whether they need updating.
    (let (new-format entry type val)
      (while (setq type (pop types))
!       ;; Jump to the proper buffer to find out the value of the
!       ;; variable, if possible.  (It may be buffer-local.)
        (save-excursion
        (let ((buffer (intern (format "gnus-%s-buffer" type)))
              val)
***************
*** 243,281 ****
  (defun gnus-balloon-face-function (form type)
    `(gnus-put-text-property
      (point) (progn ,@form (point))
!     'balloon-help
      ,(intern (format "gnus-balloon-face-%d" type))))
  
  (defun gnus-tilde-max-form (el max-width)
    "Return a form that limits EL to MAX-WIDTH."
!   (let ((max (abs max-width)))
      (if (symbolp el)
!       `(if (> (length ,el) ,max)
             ,(if (< max-width 0)
!                 `(substring ,el (- (length el) ,max))
!               `(substring ,el 0 ,max))
           ,el)
        `(let ((val (eval ,el)))
!        (if (> (length val) ,max)
             ,(if (< max-width 0)
!                 `(substring val (- (length val) ,max))
!               `(substring val 0 ,max))
           val)))))
  
  (defun gnus-tilde-cut-form (el cut-width)
    "Return a form that cuts CUT-WIDTH off of EL."
!   (let ((cut (abs cut-width)))
      (if (symbolp el)
!       `(if (> (length ,el) ,cut)
             ,(if (< cut-width 0)
!                 `(substring ,el 0 (- (length el) ,cut))
!               `(substring ,el ,cut))
           ,el)
        `(let ((val (eval ,el)))
!        (if (> (length val) ,cut)
             ,(if (< cut-width 0)
!                 `(substring val 0 (- (length val) ,cut))
!               `(substring val ,cut))
           val)))))
  
  (defun gnus-tilde-ignore-form (el ignore-value)
--- 264,372 ----
  (defun gnus-balloon-face-function (form type)
    `(gnus-put-text-property
      (point) (progn ,@form (point))
!     ,(if (fboundp 'balloon-help-mode)
!        ''balloon-help
!        ''help-echo)
      ,(intern (format "gnus-balloon-face-%d" type))))
  
+ (defun gnus-spec-tab (column)
+   (if (> column 0)
+       `(insert (make-string (max (- ,column (current-column)) 0) ? ))
+     (let ((column (abs column)))
+       (if gnus-use-correct-string-widths
+         `(progn
+            (if (> (current-column) ,column)
+                (while (progn
+                         (delete-backward-char 1)
+                         (> (current-column) ,column))))
+            (insert (make-string (max (- ,column (current-column)) 0) ? )))
+       `(progn
+          (if (> (current-column) ,column)
+              (delete-region (point)
+                             (- (point) (- (current-column) ,column)))
+            (insert (make-string (max (- ,column (current-column)) 0)
+                                 ? ))))))))
+ 
+ (defun gnus-correct-length (string)
+   "Return the correct width of STRING."
+   (let ((length 0))
+     (mapcar (lambda (char) (incf length (gnus-char-width char))) string)
+     length))
+ 
+ (defun gnus-correct-substring (string start &optional end)
+   (let ((wstart 0)
+       (wend 0)
+       (wseek 0)
+       (seek 0)
+       (length (length string))
+       (string (concat string "\0")))
+     ;; Find the start position.
+     (while (and (< seek length)
+               (< wseek start))
+       (incf wseek (gnus-char-width (aref string seek)))
+       (incf seek))
+     (setq wstart seek)
+     ;; Find the end position.
+     (while (and (<= seek length)
+               (or (not end)
+                   (<= wseek end)))
+       (incf wseek (gnus-char-width (aref string seek)))
+       (incf seek))
+     (setq wend seek)
+     (substring string wstart (1- wend))))
+ 
+ (defun gnus-string-width-function ()
+   (cond
+    (gnus-use-correct-string-widths
+     'gnus-correct-length)
+    ((fboundp 'string-width)
+     'string-width)
+    (t
+     'length)))
+ 
+ (defun gnus-substring-function ()
+   (cond
+    (gnus-use-correct-string-widths
+     'gnus-correct-substring)
+    ((fboundp 'string-width)
+     'gnus-correct-substring)
+    (t
+     'substring)))
+ 
  (defun gnus-tilde-max-form (el max-width)
    "Return a form that limits EL to MAX-WIDTH."
!   (let ((max (abs max-width))
!       (length-fun (gnus-string-width-function))
!       (substring-fun (gnus-substring-function)))
      (if (symbolp el)
!       `(if (> (,length-fun ,el) ,max)
             ,(if (< max-width 0)
!                 `(,substring-fun ,el (- (,length-fun ,el) ,max))
!               `(,substring-fun ,el 0 ,max))
           ,el)
        `(let ((val (eval ,el)))
!        (if (> (,length-fun val) ,max)
             ,(if (< max-width 0)
!                 `(,substring-fun val (- (,length-fun val) ,max))
!               `(,substring-fun val 0 ,max))
           val)))))
  
  (defun gnus-tilde-cut-form (el cut-width)
    "Return a form that cuts CUT-WIDTH off of EL."
!   (let ((cut (abs cut-width))
!       (length-fun (gnus-string-width-function))
!       (substring-fun (gnus-substring-function)))
      (if (symbolp el)
!       `(if (> (,length-fun ,el) ,cut)
             ,(if (< cut-width 0)
!                 `(,substring-fun ,el 0 (- (,length-fun ,el) ,cut))
!               `(,substring-fun ,el ,cut))
           ,el)
        `(let ((val (eval ,el)))
!        (if (> (,length-fun val) ,cut)
             ,(if (< cut-width 0)
!                 `(,substring-fun val 0 (- (,length-fun val) ,cut))
!               `(,substring-fun val ,cut))
           val)))))
  
  (defun gnus-tilde-ignore-form (el ignore-value)
***************
*** 287,292 ****
--- 378,405 ----
         (if (equal val ,ignore-value)
           "" val))))
  
+ (defun gnus-pad-form (el pad-width)
+   "Return a form that pads EL to PAD-WIDTH accounting for multi-column
+ characters correctly. This is because `format' may pad to columns or to
+ characters when given a pad value."
+   (let ((pad (abs pad-width))
+       (side (< 0 pad-width))
+       (length-fun (gnus-string-width-function)))
+     (if (symbolp el)
+       `(let ((need (- ,pad (,length-fun ,el))))
+          (if (> need 0)
+              (concat ,(when side '(make-string need ?\ ))
+                      ,el
+                      ,(when (not side) '(make-string need ?\ )))
+            ,el))
+       `(let* ((val (eval ,el))
+             (need (- ,pad (,length-fun val))))
+        (if (> need 0)
+            (concat ,(when side '(make-string need ?\ ))
+                    val
+                    ,(when (not side) '(make-string need ?\ )))
+          val)))))
+ 
  (defun gnus-parse-format (format spec-alist &optional insert)
    ;; This function parses the FORMAT string with the help of the
    ;; SPEC-ALIST and returns a list that can be eval'ed to return the
***************
*** 294,345 ****
    ;; the text between them will have the mouse-face text property.
    ;; If the FORMAT string contains the specifiers %[ and %], the text between
    ;; them will have the balloon-help text property.
!   (if (string-match
!        "\\`\\(.*\\)%[0-9]?[{(«]\\(.*\\)%[0-9]?[»})]\\(.*\n?\\)\\'"
!        format)
!       (gnus-parse-complex-format format spec-alist)
!     ;; This is a simple format.
!     (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 "(\"")
!     (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 " \""))
!         (replace-match "\")\""))))
!     (goto-char (point-max))
!     (insert "\")")
!     (goto-char (point-min))
!     (let ((form (read (current-buffer))))
!       (cons 'progn (gnus-complex-form-to-spec form spec-alist)))))
  
  (defun gnus-complex-form-to-spec (form spec-alist)
    (delq nil
        (mapcar
         (lambda (sform)
!          (if (stringp sform)
!              (gnus-parse-simple-format sform spec-alist t)
             (funcall (intern (format "gnus-%s-face-function" (car sform)))
                      (gnus-complex-form-to-spec (cddr sform) spec-alist)
!                     (nth 1 sform))))
         form)))
  
  (defun gnus-parse-simple-format (format spec-alist &optional insert)
    ;; This function parses the FORMAT string with the help of the
    ;; SPEC-ALIST and returns a list that can be eval'ed to return a
--- 407,521 ----
    ;; the text between them will have the mouse-face text property.
    ;; If the FORMAT string contains the specifiers %[ and %], the text between
    ;; them will have the balloon-help text property.
!   (let ((case-fold-search nil))
!     (if (string-match
!        
"\\`\\(.*\\)%[0-9]?[{(«]\\(.*\\)%[0-9]?[»})]\\(.*\n?\\)\\'\\|%[-0-9]*=\\|%[-0-9]*\\*"
!        format)
!       (gnus-parse-complex-format format spec-alist)
!       ;; This is a simple format.
!       (gnus-parse-simple-format format spec-alist insert))))
  
  (defun gnus-parse-complex-format (format spec-alist)
!   (let ((cursor-spec nil))
!     (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]+\\)?\\*" nil t)
!         (replace-match "\"(point)\"" t t)
!         (setq cursor-spec 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 cursor-spec
!           `(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
        (mapcar
         (lambda (sform)
!          (cond
!           ((stringp sform)
!            (gnus-parse-simple-format sform spec-alist t))
!           ((eq (car sform) 'point)
!            '(setq gnus-position (point)))
!           ((eq (car sform) 'tab)
!            (gnus-spec-tab (cadr sform)))
!           (t
             (funcall (intern (format "gnus-%s-face-function" (car sform)))
                      (gnus-complex-form-to-spec (cddr sform) spec-alist)
!                     (nth 1 sform)))))
         form)))
  
+ 
+ (defun gnus-xmas-format (fstring &rest args)
+   "A version of `format' which preserves text properties.
+ 
+ Required for XEmacs, where the built in `format' function strips all text
+ properties from both the format string and any inserted strings.
+ 
+ Only supports the format sequence %s, and %% for inserting
+ literal % characters. A pad width and an optional - (to right pad)
+ are supported for %s."
+   (let ((re "%%\\|%\\(-\\)?\\([1-9][0-9]*\\)?s")
+       (n (length args)))
+     (with-temp-buffer
+       (insert fstring)
+       (goto-char (point-min))
+       (while (re-search-forward re nil t)
+       (goto-char (match-end 0))
+       (cond
+        ((string= (match-string 0) "%%")
+         (delete-char -1))
+        (t
+         (if (null args)
+             (error 'wrong-number-of-arguments #'my-format n fstring))
+         (let* ((minlen (string-to-int (or (match-string 2) "")))
+                (arg (car args))
+                (str (if (stringp arg) arg (format "%s" arg)))
+                (lpad (null (match-string 1)))
+                (padlen (max 0 (- minlen (length str)))))
+           (replace-match "")
+           (if lpad (insert-char ?\  padlen))
+           (insert str)
+           (unless lpad (insert-char ?\  padlen))
+           (setq args (cdr args))))))
+       (buffer-string))))
+ 
  (defun gnus-parse-simple-format (format spec-alist &optional insert)
    ;; This function parses the FORMAT string with the help of the
    ;; SPEC-ALIST and returns a list that can be eval'ed to return a
***************
*** 347,353 ****
    (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)
      (save-excursion
        (gnus-set-work-buffer)
        (insert format)
--- 523,529 ----
    (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 extended-spec)
      (save-excursion
        (gnus-set-work-buffer)
        (insert format)
***************
*** 359,365 ****
              max-width nil
              cut-width nil
              ignore-value nil
!             tilde-form nil)
        (setq spec-beg (1- (point)))
  
        ;; Parse this spec fully.
--- 535,542 ----
              max-width nil
              cut-width nil
              ignore-value nil
!             tilde-form nil
!             extended-spec nil)
        (setq spec-beg (1- (point)))
  
        ;; Parse this spec fully.
***************
*** 400,409 ****
              t)
             (t
              nil)))
!       ;; User-defined spec -- find the spec name.
!       (when (eq (setq spec (char-after)) ?u)
          (forward-char 1)
!         (setq user-defined (char-after)))
        (forward-char 1)
        (delete-region spec-beg (point))
  
--- 577,594 ----
              t)
             (t
              nil)))
!       (cond
!        ;; User-defined spec -- find the spec name.
!        ((eq (setq spec (char-after)) ?u)
          (forward-char 1)
!         (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))
  
***************
*** 421,440 ****
           (user-defined
            (setq elem
                  (list
!                  (list (intern (format "gnus-user-format-function-%c"
!                                        user-defined))
                         'gnus-tmp-header)
                   ?s)))
           ;; Find the specification from `spec-alist'.
!          ((setq elem (cdr (assq spec spec-alist))))
           (t
            (setq elem '("*" ?s))))
          (setq elem-type (cadr elem))
          ;; Insert the new format elements.
!         (when pad-width
            (insert (number-to-string pad-width)))
          ;; Create the form to be evaled.
!         (if (or max-width cut-width ignore-value)
              (progn
                (insert ?s)
                (let ((el (car elem)))
--- 606,632 ----
           (user-defined
            (setq elem
                  (list
!                  (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 (or extended-spec spec) spec-alist))))
           (t
            (setq elem '("*" ?s))))
          (setq elem-type (cadr elem))
          ;; Insert the new format elements.
!         (when (and pad-width
!                    (not (and (featurep 'xemacs)
!                              gnus-use-correct-string-widths)))
            (insert (number-to-string pad-width)))
          ;; Create the form to be evaled.
!         (if (or max-width cut-width ignore-value
!                 (and (featurep 'xemacs)
!                      gnus-use-correct-string-widths))
              (progn
                (insert ?s)
                (let ((el (car elem)))
***************
*** 448,463 ****
                    (setq el (gnus-tilde-cut-form el cut-width)))
                  (when max-width
                    (setq el (gnus-tilde-max-form el max-width)))
                  (push el flist)))
            (insert elem-type)
            (push (car elem) flist))))
!       (setq fstring (buffer-string)))
  
      ;; Do some postprocessing to increase efficiency.
      (setq
       result
       (cond
!       ;; Emptyness.
        ((string= fstring "")
         nil)
        ;; Not a format string.
--- 640,657 ----
                    (setq el (gnus-tilde-cut-form el cut-width)))
                  (when max-width
                    (setq el (gnus-tilde-max-form el max-width)))
+                 (when pad-width
+                   (setq el (gnus-pad-form el pad-width)))
                  (push el flist)))
            (insert elem-type)
            (push (car elem) flist))))
!       (setq fstring (buffer-substring-no-properties (point-min) (point-max))))
  
      ;; Do some postprocessing to increase efficiency.
      (setq
       result
       (cond
!       ;; Emptiness.
        ((string= fstring "")
         nil)
        ;; Not a format string.
***************
*** 487,492 ****
--- 681,693 ----
        ;; A single string spec in the end of the spec.
        ((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring)
         (list (match-string 1 fstring) (car flist)))
+       ;; Only string (and %) specs (XEmacs only!)
+       ((and (featurep 'xemacs)
+           gnus-make-format-preserve-properties
+           (string-match
+            "\\`\\([^%]*\\(%%\\|%-?\\([1-9][0-9]*\\)?s\\)\\)*[^%]*\\'"
+            fstring))
+        (list (cons 'gnus-xmas-format (cons fstring (nreverse flist)))))
        ;; A more complex spec.
        (t
         (list (cons 'format (cons fstring (nreverse flist)))))))
***************
*** 522,528 ****
  
        (while entries
        (setq entry (pop entries))
!       (if (eq (car entry) 'version)
            (setq gnus-format-specs (delq entry gnus-format-specs))
          (let ((form (caddr entry)))
            (when (and (listp form)
--- 723,729 ----
  
        (while entries
        (setq entry (pop entries))
!       (if (memq (car entry) '(gnus-version version))
            (setq gnus-format-specs (delq entry gnus-format-specs))
          (let ((form (caddr entry)))
            (when (and (listp form)
***************
*** 531,537 ****
                       ;; Under XEmacs, it's (funcall #<compiled-function ...>)
                       (not (and (eq 'funcall (car form))
                                 (byte-code-function-p (cadr form)))))
!             (fset 'gnus-tmp-func `(lambda () ,form))
              (byte-compile 'gnus-tmp-func)
              (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func))))))
  
--- 732,738 ----
                       ;; Under XEmacs, it's (funcall #<compiled-function ...>)
                       (not (and (eq 'funcall (car form))
                                 (byte-code-function-p (cadr form)))))
!             (defalias 'gnus-tmp-func `(lambda () ,form))
              (byte-compile 'gnus-tmp-func)
              (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func))))))
  




reply via email to

[Prev in Thread] Current Thread [Next in Thread]