Sync up with Pterodactyl Gnus v0.92.
[elisp/gnus.git-] / lisp / gnus-xmas.el
index 195ad8a..1446289 100644 (file)
@@ -2,6 +2,7 @@
 ;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;;     Katsumi Yamaoka <yamaoka@jpl.org>
 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
@@ -77,7 +78,7 @@ automatically."
   (if (or (featurep 'xface)
          (featurep 'xpm))
       'gnus-xmas-article-display-xface
-    "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -")
+    "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | ee -")
   "*String or function to be executed to display an X-Face header.
 If it is a string, the command will be executed in a sub-shell
 asynchronously.         The compressed face will be piped to this command."
@@ -177,7 +178,7 @@ displayed, no centering will be performed."
     (sit-for 0))
   (when gnus-auto-center-summary
     (let* ((height (if (fboundp 'window-displayed-height)
-                      (window-displayed-height)
+                      (1- (window-displayed-height))
                     (- (window-height) 2)))
           (top (cond ((< height 4) 0)
                      ((< height 7) 1)
@@ -492,8 +493,112 @@ 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-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)
+               `(let ((val (format "%s" ,el)))
+                  (concat val (make-string
+                               (max 0 (- ,pad (string-width val))) ?\ )))
+             `(let ((val (format "%s" ,el)))
+                (concat (make-string
+                         (max 0 (- ,pad (string-width val))) ?\ )
+                        val)))
+         (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-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.
 
@@ -577,7 +682,7 @@ call it with the value of the `gnus-data' text property."
                                'default-toolbar
                              nil)
   "*If nil, do not use a toolbar.
-If it is non-nil, it must be a toolbar.  The five legal values are
+If it is non-nil, it must be a toolbar.  The five valid values are
 `default-toolbar', `top-toolbar', `bottom-toolbar',
 `right-toolbar', and `left-toolbar'."
   :type '(choice (const default-toolbar)
@@ -597,8 +702,7 @@ If it is non-nil, it must be a toolbar.  The five legal values are
     [gnus-group-unsubscribe gnus-group-unsubscribe t "Unsubscribe group"]
     [gnus-group-subscribe gnus-group-subscribe t "Subscribe group"]
     [gnus-group-kill-group gnus-group-kill-group t "Kill group"]
-    [gnus-group-exit gnus-group-exit t "Exit Gnus"]
-    )
+    [gnus-group-exit gnus-group-exit t "Exit Gnus"])
   "The group buffer toolbar.")
 
 (defvar gnus-summary-toolbar