2001-08-19 Simon Josefsson <jas@extundo.com>

[gnus] / lisp / gnus-spec.el

diff --git a/lisp/gnus-spec.el b/lisp/gnus-spec.el
index ec659c1..14266b0 100644 (file)
--- a/lisp/gnus-spec.el
+++ b/lisp/gnus-spec.el
@@ -1,5 +1,6 @@
-;;; gnus-spec.el --- format spec functions for Gnus
-;; Copyright (C) 1996-2000 Free Software Foundation, Inc.
+;;; 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 <larsi@gnus.org>
 ;; Keywords: news
@@ -29,6 +30,11 @@
 
 (require 'gnus)
 
+(defcustom gnus-use-correct-string-widths t
+  "*If non-nil, use correct functions for dealing with wide characters."
+  :group 'gnus-format
+  :type 'boolean)
+
 ;;; Internal variables.
 
 (defvar gnus-summary-mark-positions nil)
@@ -122,7 +128,7 @@
     (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"
+    (summary "%U\%R\%z\%I\%(%[%4L: %-23,23n%]%) %s\n"
             ,gnus-summary-line-format-spec))
   "Alist of format specs.")
 
@@ -245,20 +251,74 @@
     'balloon-help
     ,(intern (format "gnus-balloon-face-%d" type))))
 
+(eval-and-compile
+  (defalias 'gnus-char-width
+    (if (fboundp 'char-width)
+       'char-width
+      (lambda (ch) 1)))) ;; A simple hack.
+
+(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 end)
+  (let ((wstart 0)
+       (wend 0)
+       (seek 0)
+       (length (length string)))
+    ;; Find the start position.
+    (while (and (< seek length)
+               (< wstart start))
+      (incf wstart (gnus-char-width (aref string seek)))
+      (incf seek))
+    (setq wend wstart
+         wstart seek)
+    ;; Find the end position.
+    (while (and (< seek length)
+               (< wend end))
+      (incf wend (gnus-char-width (aref string seek)))
+      (incf seek))
+    (setq wend seek)
+    (substring string wstart (1- wend))))
+
 (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 (> (,(if gnus-use-correct-string-widths
+                     'gnus-correct-length
+                   'length) ,el)
+               ,max)
             ,(if (< max-width 0)
-                 `(substring ,el (- (length el) ,max))
-               `(substring ,el 0 ,max))
+                 `(,(if gnus-use-correct-string-widths
+                        'gnus-correct-substring
+                      'substring)
+                   ,el (- (,(if gnus-use-correct-string-widths
+                                'gnus-correct-length
+                              'length)
+                           el) ,max))
+               `(,(if gnus-use-correct-string-widths
+                      'gnus-correct-substring
+                    'substring)
+                 ,el 0 ,max))
           ,el)
       `(let ((val (eval ,el)))
-        (if (> (length val) ,max)
+        (if (> (,(if gnus-use-correct-string-widths
+                     'gnus-correct-length
+                   'length) val) ,max)
             ,(if (< max-width 0)
-                 `(substring val (- (length val) ,max))
-               `(substring val 0 ,max))
+                 `(,(if gnus-use-correct-string-widths
+                        'gnus-correct-substring
+                      'substring)
+                   val (- (,(if gnus-use-correct-string-widths
+                                'gnus-correct-length
+                              'length) val) ,max))
+               `(,(if gnus-use-correct-string-widths
+                      'gnus-correct-substring
+                    'substring)
+                 val 0 ,max))
           val)))))
 
 (defun gnus-tilde-cut-form (el cut-width)
@@ -530,7 +590,7 @@ If PROPS, insert the result."
                       ;; 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))
+             (defalias 'gnus-tmp-func `(lambda () ,form))
              (byte-compile 'gnus-tmp-func)
              (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func))))))