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