True up the width of the summary lines under XEmacs-mule.

diff --git a/ChangeLog b/ChangeLog
index 3f27f7c..e2a5018 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,15 @@
+1998-08-26  Katsumi Yamaoka   <yamaoka@jpl.org>
+
+       * lisp/gnus-spec.el (gnus-parse-simple-format): Use
+       `gnus-tilde-pad-form' instead of the padding faculty of `format'
+       under XEmacs-mule.
+
+       * lisp/gnus-xmas.el
+       (gnus-xmas-redefine): Redifine `gnus-truncate-string',
+       `gnus-tilde-max-form' and `gnus-tilde-cut-form' for XEmacs-mule.
+       (gnus-xmas-define): New function 'gnus-tilde-pad-form' for
+       XEmacs-mule.
+
 1998-08-26  Shuhei KOBAYASHI  <shuhei-k@jaist.ac.jp>
 
        * lisp/gnus-art.el (gnus-article-narrow-to-signature):

diff --git a/lisp/gnus-spec.el b/lisp/gnus-spec.el
index 23215fb..85b2866 100644 (file)
--- a/lisp/gnus-spec.el
+++ b/lisp/gnus-spec.el
@@ -333,15 +333,16 @@
   ;; 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
   ;; string.
-  (let ((max-width 0)
+  (let (max-width
        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
+       (xemacs-mule-p (and gnus-xemacs (featurep 'mule))))
     (save-excursion
       (gnus-set-work-buffer)
       (insert format)
       (goto-char (point-min))
-      (while (re-search-forward "%" nil t)
+      (while (search-forward "%" nil t)
        (setq user-defined nil
              spec-beg nil
              pad-width nil
@@ -420,10 +421,11 @@
            (setq elem '("*" ?s))))
          (setq elem-type (cadr elem))
          ;; Insert the new format elements.
-         (when pad-width
-           (insert (number-to-string pad-width)))
+         (and pad-width (not xemacs-mule-p)
+              (insert (number-to-string pad-width)))
          ;; Create the form to be evaled.
-         (if (or max-width cut-width ignore-value)
+         (if (or max-width cut-width ignore-value
+                 (and pad-width xemacs-mule-p))
              (progn
                (insert ?s)
                (let ((el (car elem)))
@@ -437,6 +439,8 @@
                    (setq el (gnus-tilde-cut-form el cut-width)))
                  (when max-width
                    (setq el (gnus-tilde-max-form el max-width)))
+                 (and pad-width xemacs-mule-p
+                      (setq el (gnus-tilde-pad-form el pad-width)))
                  (push el flist)))
            (insert elem-type)
            (push (car elem) flist))))

diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el
index 00fc583..d8106d1 100644 (file)
--- a/lisp/gnus-xmas.el
+++ b/lisp/gnus-xmas.el
@@ -478,7 +478,28 @@ call it with the value of the `gnus-data' text property."
            'x-color-values
          (lambda (color)
            (color-instance-rgb-components
-            (make-color-instance color))))))
+            (make-color-instance color)))))
+
+  (when (featurep 'mule)
+    (defun gnus-tilde-pad-form (el pad-width)
+      "Return a form that pads EL to PAD-WIDTH."
+      (let ((pad (abs pad-width)))
+       (if (symbolp el)
+           (if (< pad-width 0)
+               `(concat ,el (make-string
+                             (max 0 (- ,pad (string-width ,el))) ?\ ))
+             `(concat (make-string
+                       (max 0 (- ,pad (string-width ,el))) ?\ )
+                      ,el))
+         (if (< pad-width 0)
+             `(let ((val (eval ,el)))
+                (concat val (make-string
+                             (max 0 (- ,pad (string-width val))) ?\ )))
+           `(let ((val (eval ,el)))
+              (concat (make-string
+                       (max 0 (- ,pad (string-width val))) ?\ )
+                      val))))))
+    ))
 
 (defun gnus-xmas-redefine ()
   "Redefine lots of Gnus functions for XEmacs."
@@ -524,8 +545,91 @@ call it with the value of the `gnus-data' text property."
   (add-hook 'gnus-draft-mode-hook 'gnus-xmas-draft-menu-add)
   (add-hook 'gnus-summary-mode-hook
            'gnus-xmas-switch-horizontal-scrollbar-off)
-  (add-hook 'gnus-tree-mode-hook 'gnus-xmas-switch-horizontal-scrollbar-off))
-
+  (add-hook 'gnus-tree-mode-hook 'gnus-xmas-switch-horizontal-scrollbar-off)
+
+  (when (featurep 'mule)
+    (defun gnus-truncate-string (str end-column &optional start-column padding)
+      "Truncate string STR to end at column END-COLUMN.
+The optional 2nd arg START-COLUMN, if non-nil, specifies
+the starting column; that means to return the characters occupying
+columns START-COLUMN ... END-COLUMN of STR.
+
+The optional 3rd arg PADDING, if non-nil, specifies a padding character
+to add at the end of the result if STR doesn't reach column END-COLUMN,
+or if END-COLUMN comes in the middle of a character in STR.
+PADDING is also added at the beginning of the result
+if column START-COLUMN appears in the middle of a character in STR.
+
+If PADDING is nil, no padding is added in these cases, so
+the resulting string may be narrower than END-COLUMN.
+\[Emacs 20.3 emulating function]"
+      (or start-column
+         (setq start-column 0))
+      (let ((len (length str))
+           (idx 0)
+           (column 0)
+           (head-padding "") (tail-padding "")
+           ch last-column last-idx from-idx)
+       (condition-case nil
+           (while (< column start-column)
+             (setq ch (aref str idx)
+                   column (+ column (char-width ch))
+                   idx (1+ idx)))
+         (args-out-of-range (setq idx len)))
+       (if (< column start-column)
+           (if padding (make-string end-column padding) "")
+         (if (and padding (> column start-column))
+             (setq head-padding
+                   (make-string (- column start-column) padding)))
+         (setq from-idx idx)
+         (if (< end-column column)
+             (setq idx from-idx)
+           (condition-case nil
+               (while (< column end-column)
+                 (setq last-column column
+                       last-idx idx
+                       ch (aref str idx)
+                       column (+ column (char-width ch))
+                       idx (1+ idx)))
+             (args-out-of-range (setq idx len)))
+           (if (> column end-column)
+               (setq column last-column idx last-idx))
+           (if (and padding (< column end-column))
+               (setq tail-padding
+                     (make-string (- end-column column) padding))))
+         (setq str (substring str from-idx idx))
+         (if padding
+             (concat head-padding str tail-padding)
+           str))))
+
+    (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 (< max-width 0)
+               `(let ((width (string-width ,el)))
+                  (gnus-truncate-string ,el width (- width ,max)))
+             `(gnus-truncate-string ,el ,max))
+         (if (< max-width 0)
+             `(let* ((val (eval ,el))
+                     (width (string-width val)))
+                (gnus-truncate-string val width (- width ,max)))
+           `(let ((val (eval ,el)))
+              (gnus-truncate-string val ,max))))))
+
+    (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 (< cut-width 0)
+               `(gnus-truncate-string ,el (- (string-width ,el) ,cut))
+             `(gnus-truncate-string ,el (string-width ,el) ,cut))
+         (if (< cut-width 0)
+             `(let ((val (eval ,el)))
+                (gnus-truncate-string val (- (string-width val) ,cut)))
+           `(let ((val (eval ,el)))
+              (gnus-truncate-string val (string-width val) ,cut))))))
+    ))
 
 ;;; XEmacs logo and toolbar.