cgit.sxemacs.org Git - gnus/blob - lisp/gnus-ems.el

   1 ;;; gnus-ems.el --- functions for making Gnus work under different Emacsen
   2 ;; Copyright (C) 1995 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
   5 ;; Keywords: news
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  21 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  22
  23 ;;; Commentary:
  24
  25 ;;; Code:
  26
  27 (defvar gnus-mouse-2 [mouse-2])
  28 (defvar gnus-easymenu 'easymenu)
  29 (defvar gnus-group-mode-hook ())
  30 (defvar gnus-summary-mode-hook ())
  31 (defvar gnus-article-mode-hook ())
  32
  33 ;; We do not byte-compile this file, because error messages are such a
  34 ;; bore.
  35
  36 (eval
  37  '(progn
  38     (if (string-match "XEmacs\\|Lucid" emacs-version)
  39         ()
  40       ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
  41       (defvar gnus-display-type
  42         (condition-case nil
  43             (let ((display-resource (x-get-resource ".displayType" "DisplayType")))
  44               (cond (display-resource (intern (downcase display-resource)))
  45                     ((x-display-color-p) 'color)
  46                     ((x-display-grayscale-p) 'grayscale)
  47                     (t 'mono)))
  48           (error 'mono))
  49         "A symbol indicating the display Emacs is running under.
  50 The symbol should be one of `color', `grayscale' or `mono'. If Emacs
  51 guesses this display attribute wrongly, either set this variable in
  52 your `~/.emacs' or set the resource `Emacs.displayType' in your
  53 `~/.Xdefaults'. See also `gnus-background-mode'.
  54
  55 This is a meta-variable that will affect what default values other
  56 variables get.  You would normally not change this variable, but
  57 pounce directly on the real variables themselves.")
  58
  59       (defvar gnus-background-mode
  60         (condition-case nil
  61             (let ((bg-resource (x-get-resource ".backgroundMode"
  62                                                "BackgroundMode"))
  63                   (params (frame-parameters)))
  64               (cond (bg-resource (intern (downcase bg-resource)))
  65                     ((and (cdr (assq 'background-color params))
  66                           (< (apply '+ (x-color-values
  67                                         (cdr (assq 'background-color params))))
  68                              (/ (apply '+ (x-color-values "white")) 3)))
  69                      'dark)
  70                     (t 'light)))
  71           (error 'light))
  72         "A symbol indicating the Emacs background brightness.
  73 The symbol should be one of `light' or `dark'.
  74 If Emacs guesses this frame attribute wrongly, either set this variable in
  75 your `~/.emacs' or set the resource `Emacs.backgroundMode' in your
  76 `~/.Xdefaults'.
  77 See also `gnus-display-type'.
  78
  79 This is a meta-variable that will affect what default values other
  80 variables get.  You would normally not change this variable, but
  81 pounce directly on the real variables themselves."))
  82
  83     (cond
  84      ((string-match "XEmacs\\|Lucid" emacs-version)
  85       ;; XEmacs definitions.
  86
  87       (setq gnus-mouse-2 [button2])
  88       (setq gnus-easymenu 'auc-menu)
  89
  90       (or (memq 'underline (list-faces))
  91           (funcall (intern "make-face") 'underline))
  92       ;; Must avoid calling set-face-underline-p directly, because it
  93       ;; is a defsubst in emacs19, and will make the .elc files non
  94       ;; portable!
  95       (or (face-differs-from-default-p 'underline)
  96           (funcall 'set-face-underline-p 'underline t))
  97       (or (fboundp 'set-text-properties)
  98           (defun set-text-properties (start end props &optional buffer)
  99             (if (or (null buffer) (bufferp buffer))
 100                 (if props
 101                     (while props
 102                       (put-text-property
 103                        start end (car props) (nth 1 props) buffer)
 104                       (setq props (nthcdr 2 props)))
 105                   (remove-text-properties start end ())))))
 106
 107       (or (fboundp 'make-overlay) (fset 'make-overlay 'make-extent))
 108       (or (fboundp 'overlay-put) (fset 'overlay-put 'set-extent-property))
 109       (or (fboundp 'move-overlay)
 110           (defun move-overlay (extent start end &optional buffer)
 111             (set-extent-endpoints extent start end)))
 112       (or (boundp 'standard-display-table) (setq standard-display-table nil))
 113       (or (boundp 'read-event) (fset 'read-event 'next-command-event))
 114
 115       ;; Fix by "jeff (j.d.) sparkes" <jsparkes@bnr.ca>.
 116       (defvar gnus-display-type (device-class)
 117         "A symbol indicating the display Emacs is running under.
 118 The symbol should be one of `color', `grayscale' or `mono'. If Emacs
 119 guesses this display attribute wrongly, either set this variable in
 120 your `~/.emacs' or set the resource `Emacs.displayType' in your
 121 `~/.Xdefaults'. See also `gnus-background-mode'.
 122
 123 This is a meta-variable that will affect what default values other
 124 variables get.  You would normally not change this variable, but
 125 pounce directly on the real variables themselves.")
 126
 127
 128       (or (fboundp 'x-color-values)
 129           (fset 'x-color-values
 130                 (lambda (color)
 131                   (color-instance-rgb-components
 132                    (make-color-instance color)))))
 133
 134       (defvar gnus-background-mode
 135         (let ((bg-resource
 136                (x-get-resource ".backgroundMode" "BackgroundMode" 'string))
 137               (params (frame-parameters)))
 138           (cond (bg-resource (intern (downcase bg-resource)))
 139                 ((and (assq 'background-color params)
 140                       (< (apply '+ (x-color-values
 141                                     (cdr (assq 'background-color params))))
 142                          (/ (apply '+ (x-color-values "white")) 3)))
 143                  'dark)
 144                 (t 'light)))
 145         "A symbol indicating the Emacs background brightness.
 146 The symbol should be one of `light' or `dark'.
 147 If Emacs guesses this frame attribute wrongly, either set this variable in
 148 your `~/.emacs' or set the resource `Emacs.backgroundMode' in your
 149 `~/.Xdefaults'.
 150 See also `gnus-display-type'.
 151
 152 This is a meta-variable that will affect what default values other
 153 variables get.  You would normally not change this variable, but
 154 pounce directly on the real variables themselves.")
 155
 156
 157       (defun gnus-install-mouse-tracker ()
 158         (require 'mode-motion)
 159         (setq mode-motion-hook 'mode-motion-highlight-line)))
 160
 161      ((and (not (string-match "28.9" emacs-version))
 162            (not (string-match "29" emacs-version)))
 163       (setq gnus-hidden-properties '(invisible t))
 164       (or (fboundp 'buffer-substring-no-properties)
 165           (defun buffer-substring-no-properties (beg end)
 166             (format "%s" (buffer-substring beg end)))))
 167
 168      ((boundp 'MULE)
 169       (provide 'gnusutil))
 170
 171      )))
 172
 173 (eval-and-compile
 174   (cond
 175    ((not window-system)
 176     (defun gnus-dummy-func (&rest args))
 177     (let ((funcs '(mouse-set-point set-face-foreground
 178                                    set-face-background x-popup-menu)))
 179       (while funcs
 180         (or (fboundp (car funcs))
 181             (fset (car funcs) 'gnus-dummy-func))
 182         (setq funcs (cdr funcs))))))
 183   (or (fboundp 'file-regular-p)
 184       (defun file-regular-p (file)
 185         (and (not (file-directory-p file))
 186              (not (file-symlink-p file))
 187              (file-exists-p file))))
 188   (or (fboundp 'face-list)
 189       (defun face-list (&rest args)))
 190   )
 191
 192 (defun gnus-ems-redefine ()
 193   (cond
 194    ((string-match "XEmacs\\|Lucid" emacs-version)
 195     ;; XEmacs definitions.
 196     (fset 'gnus-mouse-face-function 'identity)
 197     (fset 'gnus-summary-make-display-table (lambda () nil))
 198     (fset 'gnus-visual-turn-off-edit-menu 'identity)
 199
 200     (defun gnus-highlight-selected-summary ()
 201       ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
 202       ;; Highlight selected article in summary buffer
 203       (if gnus-summary-selected-face
 204           (save-excursion
 205             (let* ((beg (progn (beginning-of-line) (point)))
 206                    (end (progn (end-of-line) (point)))
 207                    (to (max 1 (1- (or (previous-single-property-change
 208                                        end 'mouse-face nil beg) end))))
 209                    (from (1+ (or (next-single-property-change
 210                                   beg 'mouse-face nil end) beg))))
 211               (if (< to beg)
 212                   (progn
 213                     (setq from beg)
 214                     (setq to end)))
 215               (if gnus-newsgroup-selected-overlay
 216                   (delete-extent gnus-newsgroup-selected-overlay))
 217               (setq gnus-newsgroup-selected-overlay
 218                     (make-extent from to))
 219               (set-extent-face gnus-newsgroup-selected-overlay
 220                                gnus-summary-selected-face)))))
 221
 222
 223     (defun gnus-summary-recenter ()
 224       (let* ((top (cond ((< (window-height) 4) 0)
 225                         ((< (window-height) 7) 1)
 226                         (t 2)))
 227              (height (- (window-height) 2))
 228              (bottom (save-excursion (goto-char (point-max))
 229                                      (forward-line (- height))
 230                                      (point)))
 231              (window (get-buffer-window (current-buffer))))
 232         (and
 233          ;; The user has to want it,
 234          gnus-auto-center-summary
 235          ;; the article buffer must be displayed,
 236          (get-buffer-window gnus-article-buffer)
 237          ;; Set the window start to either `bottom', which is the biggest
 238          ;; possible valid number, or the second line from the top,
 239          ;; whichever is the least.
 240          (set-window-start
 241           window (min bottom (save-excursion (forward-line (- top))
 242                                              (point)))))))
 243
 244     (defun gnus-group-insert-group-line-info (group)
 245       (let ((entry (gnus-gethash group gnus-newsrc-hashtb))
 246             (beg (point))
 247             active info)
 248         (if entry
 249             (progn
 250               (setq info (nth 2 entry))
 251               (gnus-group-insert-group-line
 252                nil group (nth 1 info) (nth 3 info) (car entry) (nth 4 info)))
 253           (setq active (gnus-gethash group gnus-active-hashtb))
 254
 255           (gnus-group-insert-group-line
 256            nil group (if (member group gnus-zombie-list) gnus-level-zombie
 257                        gnus-level-killed)
 258            nil (if active (- (1+ (cdr active)) (car active)) 0) nil))
 259         (save-excursion
 260          (goto-char beg)
 261          (remove-text-properties
 262           (1+ (gnus-point-at-bol)) (1+ (gnus-point-at-eol))
 263           '(gnus-group nil)))))
 264
 265     (defun gnus-copy-article-buffer (&optional article-buffer)
 266       (setq gnus-article-copy (get-buffer-create " *gnus article copy*"))
 267       (buffer-disable-undo gnus-article-copy)
 268       (or (memq gnus-article-copy gnus-buffer-list)
 269           (setq gnus-buffer-list (cons gnus-article-copy gnus-buffer-list)))
 270       (let ((article-buffer (or article-buffer gnus-article-buffer))
 271             buf)
 272         (if (and (get-buffer article-buffer)
 273                  (buffer-name (get-buffer article-buffer)))
 274             (save-excursion
 275               (set-buffer article-buffer)
 276               (widen)
 277               (setq buf (buffer-substring (point-min) (point-max)))
 278               (set-buffer gnus-article-copy)
 279               (erase-buffer)
 280               (insert (format "%s" buf))))))
 281
 282     (defun gnus-summary-refer-article (message-id)
 283       "Refer article specified by MESSAGE-ID.
 284 NOTE: This command only works with newsgroups that use real or simulated NNTP."
 285       (interactive "sMessage-ID: ")
 286       (if (or (not (stringp message-id))
 287               (zerop (length message-id)))
 288           ()
 289         ;; Construct the correct Message-ID if necessary.
 290         ;; Suggested by tale@pawl.rpi.edu.
 291         (or (string-match "^<" message-id)
 292             (setq message-id (concat "<" message-id)))
 293         (or (string-match ">$" message-id)
 294             (setq message-id (concat message-id ">")))
 295         (let ((header (car (gnus-gethash (downcase message-id)
 296                                          gnus-newsgroup-dependencies))))
 297           (if header
 298               (or (gnus-summary-goto-article (header-number header))
 299                   ;; The header has been read, but the article had been
 300                   ;; expunged, so we insert it again.
 301                   (let ((beg (point)))
 302                     (gnus-summary-insert-line
 303                      nil header 0 nil gnus-read-mark nil nil
 304                      (header-subject header))
 305                     (save-excursion
 306                       (goto-char beg)
 307                       (remove-text-properties
 308                        (1+ (gnus-point-at-bol)) (1+ (gnus-point-at-eol))
 309                        '(gnus-number nil gnus-mark nil gnus-level nil)))
 310                     (forward-line -1)
 311                     (header-number header)))
 312             (let ((gnus-override-method gnus-refer-article-method)
 313                   (gnus-ancient-mark gnus-read-mark)
 314                   (tmp-buf (get-buffer-create " *gnus refer"))
 315                   (tmp-point (window-start
 316                               (get-buffer-window gnus-article-buffer)))
 317                   number)
 318               (and gnus-refer-article-method
 319                    (or (gnus-server-opened gnus-refer-article-method)
 320                        (gnus-open-server gnus-refer-article-method)))
 321               ;; Save the old article buffer.
 322               (save-excursion
 323                 (set-buffer tmp-buf)
 324                 (buffer-disable-undo (current-buffer))
 325                 (insert-buffer-substring gnus-article-buffer))
 326               (prog1
 327                   (if (gnus-article-prepare
 328                        message-id nil (gnus-read-header message-id))
 329                       (progn
 330                         (setq number (header-number gnus-current-headers))
 331                         (gnus-rebuild-thread message-id)
 332                         (gnus-summary-goto-subject number)
 333                         (gnus-summary-recenter)
 334                         (gnus-article-set-window-start
 335                          (cdr (assq number gnus-newsgroup-bookmarks)))
 336                         message-id)
 337                     ;; We restore the old article buffer.
 338                     (save-excursion
 339                       (set-buffer gnus-article-buffer)
 340                       (let ((buffer-read-only nil))
 341                         (insert-buffer-substring tmp-buf)
 342                         (and tmp-point
 343                              (set-window-start (get-buffer-window (current-buffer))
 344                                                tmp-point))))
 345                     nil)
 346                 (kill-buffer tmp-buf)))))))
 347
 348     (defun gnus-summary-insert-pseudos (pslist &optional not-view)
 349       (let ((buffer-read-only nil)
 350             (article (gnus-summary-article-number))
 351             b)
 352         (or (gnus-summary-goto-subject article)
 353             (error (format "No such article: %d" article)))
 354         (or gnus-newsgroup-headers-hashtb-by-number
 355             (gnus-make-headers-hashtable-by-number))
 356         (gnus-summary-position-cursor)
 357         ;; If all commands are to be bunched up on one line, we collect
 358         ;; them here.
 359         (if gnus-view-pseudos-separately
 360             ()
 361           (let ((ps (setq pslist (sort pslist 'gnus-pseudos<)))
 362                 files action)
 363             (while ps
 364               (setq action (cdr (assq 'action (car ps))))
 365               (setq files (list (cdr (assq 'name (car ps)))))
 366               (while (and ps (cdr ps)
 367                           (string= (or action "1")
 368                                    (or (cdr (assq 'action (car (cdr ps)))) "2")))
 369                 (setq files (cons (cdr (assq 'name (car (cdr ps)))) files))
 370                 (setcdr ps (cdr (cdr ps))))
 371               (if (not files)
 372                   ()
 373                 (if (not (string-match "%s" action))
 374                     (setq files (cons " " files)))
 375                 (setq files (cons " " files))
 376                 (and (assq 'execute (car ps))
 377                      (setcdr (assq 'execute (car ps))
 378                              (funcall (if (string-match "%s" action)
 379                                           'format 'concat)
 380                                       action
 381                                       (mapconcat (lambda (f) f) files " ")))))
 382               (setq ps (cdr ps)))))
 383         (if (and gnus-view-pseudos (not not-view))
 384             (while pslist
 385               (and (assq 'execute (car pslist))
 386                    (gnus-execute-command (cdr (assq 'execute (car pslist)))
 387                                          (eq gnus-view-pseudos 'not-confirm)))
 388               (setq pslist (cdr pslist)))
 389           (save-excursion
 390             (while pslist
 391               (gnus-summary-goto-subject (or (cdr (assq 'article (car pslist)))
 392                                              (gnus-summary-article-number)))
 393               (forward-line 1)
 394               (setq b (point))
 395               (insert "          " (file-name-nondirectory
 396                                     (cdr (assq 'name (car pslist))))
 397                       ": " (or (cdr (assq 'execute (car pslist))) "") "\n")
 398               (add-text-properties
 399                b (1+ b) (list 'gnus-number gnus-reffed-article-number
 400                               'gnus-mark gnus-unread-mark
 401                               'gnus-level 0
 402                               'gnus-pseudo (car pslist)))
 403               (remove-text-properties
 404                b (gnus-point-at-eol)
 405                '(gnus-number nil gnus-mark nil gnus-level nil))
 406               (forward-line -1)
 407               (gnus-sethash (int-to-string gnus-reffed-article-number)
 408                             (car pslist) gnus-newsgroup-headers-hashtb-by-number)
 409               (setq gnus-reffed-article-number (1- gnus-reffed-article-number))
 410               (setq pslist (cdr pslist)))))))
 411
 412
 413     (defun gnus-article-push-button (event)
 414       "Check text under the mouse pointer for a callback function.
 415 If the text under the mouse pointer has a `gnus-callback' property,
 416 call it with the value of the `gnus-data' text property."
 417       (interactive "e")
 418       (set-buffer (window-buffer (event-window event)))
 419       (let* ((pos (event-closest-point event))
 420              (data (get-text-property pos 'gnus-data))
 421              (fun (get-text-property pos 'gnus-callback)))
 422         (if fun (funcall fun data))))
 423
 424     ;; Re-build the thread containing ID.
 425     (defun gnus-rebuild-thread (id)
 426       (let ((dep gnus-newsgroup-dependencies)
 427             (buffer-read-only nil)
 428             parent headers refs thread art)
 429         (while (and id (setq headers
 430                              (car (setq art (gnus-gethash (downcase id)
 431                                                           dep)))))
 432           (setq parent art)
 433           (setq id (and (setq refs (header-references headers))
 434                         (string-match "\\(<[^>]+>\\) *$" refs)
 435                         (substring refs (match-beginning 1) (match-end 1)))))
 436         (setq thread (gnus-make-sub-thread (car parent)))
 437         (gnus-rebuild-remove-articles thread)
 438         (let ((beg (point)))
 439           (gnus-summary-prepare-threads (list thread) 0)
 440           (save-excursion
 441             (while (>= (point) beg)
 442               (remove-text-properties
 443                (1+ (gnus-point-at-bol)) (1+ (gnus-point-at-eol))
 444                '(gnus-number nil gnus-mark nil gnus-level nil))
 445               (forward-line -1)))
 446           (gnus-summary-update-lines beg (point)))))
 447
 448     ;; Fixed by Christopher Davis <ckd@loiosh.kei.com>.
 449     (defun gnus-article-add-button (from to fun &optional data)
 450       "Create a button between FROM and TO with callback FUN and data DATA."
 451       (and gnus-article-button-face
 452            (overlay-put (make-overlay from to) 'face gnus-article-button-face))
 453       (add-text-properties from to
 454                            (append
 455                             (and gnus-article-mouse-face
 456                                  (list 'mouse-face gnus-article-mouse-face))
 457                             (list 'gnus-callback fun)
 458                             (and data (list 'gnus-data data))
 459                             (list 'highlight t))))
 460
 461     (if (not gnus-visual)
 462         ()
 463       (setq gnus-group-mode-hook
 464             (cons
 465              '(lambda ()
 466                (easy-menu-add gnus-group-reading-menu)
 467                (easy-menu-add gnus-group-group-menu)
 468                (easy-menu-add gnus-group-post-menu)
 469                (easy-menu-add gnus-group-misc-menu)
 470                (gnus-install-mouse-tracker))
 471              gnus-group-mode-hook))
 472       (setq gnus-summary-mode-hook
 473             (cons
 474              '(lambda ()
 475                (easy-menu-add gnus-summary-mark-menu)
 476                (easy-menu-add gnus-summary-move-menu)
 477                (easy-menu-add gnus-summary-article-menu)
 478                (easy-menu-add gnus-summary-thread-menu)
 479                (easy-menu-add gnus-summary-misc-menu)
 480                (easy-menu-add gnus-summary-post-menu)
 481                (easy-menu-add gnus-summary-kill-menu)
 482                (gnus-install-mouse-tracker))
 483              gnus-summary-mode-hook))
 484       (setq gnus-article-mode-hook
 485             (cons
 486              '(lambda ()
 487                (easy-menu-add gnus-article-article-menu)
 488                (easy-menu-add gnus-article-treatment-menu))
 489              gnus-article-mode-hook)))
 490
 491     (defvar gnus-logo (make-glyph (make-specifier 'image)))
 492
 493     (defun gnus-group-startup-xmessage (&optional x y)
 494       "Insert startup message in current buffer."
 495       ;; Insert the message.
 496       (erase-buffer)
 497       (if (featurep 'xpm)
 498           (progn
 499             (set-glyph-property gnus-logo 'image  "~/tmp/gnus.xpm")
 500             (set-glyph-image gnus-logo "~/tmp/gnus.xpm" 'global 'x)
 501
 502             (insert " ")
 503             (set-extent-begin-glyph (make-extent (point) (point)) gnus-logo)
 504             (insert "
 505    Gnus * A newsreader for Emacsen
 506  A Praxis Release * larsi@ifi.uio.no")
 507             (goto-char (point-min))
 508             (while (not (eobp))
 509               (insert (make-string (/ (max (- (window-width) (or x 35)) 0) 2)
 510                                    ? ))
 511               (forward-line 1))
 512             (goto-char (point-min))
 513             ;; +4 is fuzzy factor.
 514             (insert-char ?\n (/ (max (- (window-height) (or y 24)) 0) 2)))
 515
 516         (insert
 517          (format "
 518      %s
 519            A newsreader
 520       for GNU Emacs
 521
 522         Based on GNUS
 523              written by
 524      Masanobu UMEDA
 525
 526        A Praxis Release
 527       larsi@ifi.uio.no
 528 "
 529                  gnus-version))
 530         ;; And then hack it.
 531         ;; 18 is the longest line.
 532         (indent-rigidly (point-min) (point-max)
 533                         (/ (max (- (window-width) (or x 28)) 0) 2))
 534         (goto-char (point-min))
 535         ;; +4 is fuzzy factor.
 536         (insert-char ?\n (/ (max (- (window-height) (or y 12)) 0) 2)))
 537
 538       ;; Fontify some.
 539       (goto-char (point-min))
 540       (search-forward "Praxis")
 541       (put-text-property (match-beginning 0) (match-end 0) 'face 'bold)
 542       (goto-char (point-min)))
 543
 544
 545
 546     )
 547
 548    ((boundp 'MULE)
 549     ;; Mule definitions
 550     (if (not (fboundp 'truncate-string))
 551         (defun truncate-string (str width)
 552           (let ((w (string-width str))
 553                 (col 0) (idx 0) (p-idx 0) chr)
 554             (if (<= w width)
 555                 str
 556               (while (< col width)
 557                 (setq chr (aref str idx)
 558                       col (+ col (char-width chr))
 559                       p-idx idx
 560                       idx (+ idx (char-bytes chr))
 561                       ))
 562               (substring str 0 (if (= col width)
 563                                    idx
 564                                  p-idx))
 565               )))
 566       )
 567     (defalias 'gnus-truncate-string 'truncate-string)
 568
 569     (defun gnus-cite-add-face (number prefix face)
 570       ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line.
 571       (if face
 572           (let ((inhibit-point-motion-hooks t)
 573                 from to)
 574             (goto-line number)
 575             (if (boundp 'MULE)
 576                 (forward-char (chars-in-string prefix))
 577               (forward-char (length prefix)))
 578             (skip-chars-forward " \t")
 579             (setq from (point))
 580             (end-of-line 1)
 581             (skip-chars-backward " \t")
 582             (setq to (point))
 583             (if (< from to)
 584                 (overlay-put (make-overlay from to) 'face face)))))
 585
 586     (defun gnus-max-width-function (el max-width)
 587       (` (let* ((val (eval (, el)))
 588                 (valstr (if (numberp val)
 589                             (int-to-string val) val)))
 590            (if (> (length valstr) (, max-width))
 591                (truncate-string valstr (, max-width))
 592              valstr))))
 593
 594     (fset 'gnus-summary-make-display-table (lambda () nil))
 595     )
 596    ))
 597
 598 (provide 'gnus-ems)
 599
 600 ;; Local Variables:
 601 ;; byte-compile-warnings: nil
 602 ;; End:
 603
 604 ;;; gnus-ems.el ends here