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,96 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 the
  21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25
  26 ;;; Code:
  27
  28 (eval-when-compile (require 'cl))
  29
  30 (defvar gnus-xemacs (string-match "XEmacs\\|Lucid" emacs-version)
  31   "Non-nil if running under XEmacs.")
  32
  33 (defvar gnus-mouse-2 [mouse-2])
  34
  35 (eval-and-compile
  36   (autoload 'gnus-xmas-define "gnus-xmas")
  37   (autoload 'gnus-xmas-redefine "gnus-xmas")
  38   (autoload 'appt-select-lowest-window "appt.el"))
  39
  40 (or (fboundp 'mail-file-babyl-p)
  41     (fset 'mail-file-babyl-p 'rmail-file-p))
  42
  43 ;;; Mule functions.
  44
  45 (defun gnus-mule-cite-add-face (number prefix face)
  46   ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line.
  47   (if face
  48       (let ((inhibit-point-motion-hooks t)
  49             from to)
  50         (goto-line number)
  51         (if (boundp 'MULE)
  52             (forward-char (chars-in-string prefix))
  53           (forward-char (length prefix)))
  54         (skip-chars-forward " \t")
  55         (setq from (point))
  56         (end-of-line 1)
  57         (skip-chars-backward " \t")
  58         (setq to (point))
  59         (if (< from to)
  60             (gnus-overlay-put (gnus-make-overlay from to) 'face face)))))
  61
  62 (defun gnus-mule-max-width-function (el max-width)
  63   (` (let* ((val (eval (, el)))
  64             (valstr (if (numberp val)
  65                         (int-to-string val) val)))
  66        (if (> (length valstr) (, max-width))
  67            (truncate-string valstr (, max-width))
  68          valstr))))
  69
  70 (eval-and-compile
  71   (if gnus-xemacs
  72       nil
  73
  74     (defvar gnus-mouse-face-prop 'mouse-face
  75       "Property used for highlighting mouse regions.")
  76
  77     (defvar gnus-article-x-face-command
  78       "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -"
  79       "String or function to be executed to display an X-Face header.
  80 If it is a string, the command will be executed in a sub-shell
  81 asynchronously.  The compressed face will be piped to this command.")
  82
  83     ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
  84     (defvar gnus-display-type
  85       (condition-case nil
  86           (let ((display-resource (x-get-resource ".displayType" "DisplayType")))
  87             (cond (display-resource (intern (downcase display-resource)))
  88                   ((x-display-color-p) 'color)
  89                   ((x-display-grayscale-p) 'grayscale)
  90                   (t 'mono)))
  91         (error 'mono))
  92       "A symbol indicating the display Emacs is running under.
  93 The symbol should be one of `color', `grayscale' or `mono'. If Emacs
  94 guesses this display attribute wrongly, either set this variable in
  95 your `~/.emacs' or set the resource `Emacs.displayType' in your
  96 `~/.Xdefaults'. See also `gnus-background-mode'.
  97
  98 This is a meta-variable that will affect what default values other
  99 variables get.  You would normally not change this variable, but
 100 pounce directly on the real variables themselves.")
 101
 102     (defvar gnus-background-mode
 103       (condition-case nil
 104           (let ((bg-resource (x-get-resource ".backgroundMode"
 105                                              "BackgroundMode"))
 106                 (params (frame-parameters)))
 107             (cond (bg-resource (intern (downcase bg-resource)))
 108                   ((and (cdr (assq 'background-color params))
 109                         (< (apply '+ (x-color-values
 110                                       (cdr (assq 'background-color params))))
 111                            (* (apply '+ (x-color-values "white")) .6)))
 112                    'dark)
 113                   (t 'light)))
 114         (error 'light))
 115       "A symbol indicating the Emacs background brightness.
 116 The symbol should be one of `light' or `dark'.
 117 If Emacs guesses this frame attribute wrongly, either set this variable in
 118 your `~/.emacs' or set the resource `Emacs.backgroundMode' in your
 119 `~/.Xdefaults'.
 120 See also `gnus-display-type'.
 121
 122 This is a meta-variable that will affect what default values other
 123 variables get.  You would normally not change this variable, but
 124 pounce directly on the real variables themselves."))
 125
 126   (cond
 127    ((string-match "XEmacs\\|Lucid" emacs-version)
 128     (gnus-xmas-define))
 129
 130    ((or (not (boundp 'emacs-minor-version))
 131         (< emacs-minor-version 30))
 132     ;; Remove the `intangible' prop.
 133     (let ((props (and (boundp 'gnus-hidden-properties)
 134                       gnus-hidden-properties)))
 135       (while (and props (not (eq (car (cdr props)) 'intangible)))
 136         (setq props (cdr props)))
 137       (and props (setcdr props (cdr (cdr (cdr props))))))
 138     (or (fboundp 'buffer-substring-no-properties)
 139         (defun buffer-substring-no-properties (beg end)
 140           (format "%s" (buffer-substring beg end)))))
 141
 142    ((boundp 'MULE)
 143     (provide 'gnusutil))))
 144
 145 (eval-and-compile
 146   (cond
 147    ((not window-system)
 148     (defun gnus-dummy-func (&rest args))
 149     (let ((funcs '(mouse-set-point set-face-foreground
 150                                    set-face-background x-popup-menu)))
 151       (while funcs
 152         (or (fboundp (car funcs))
 153             (fset (car funcs) 'gnus-dummy-func))
 154         (setq funcs (cdr funcs))))))
 155   (or (fboundp 'file-regular-p)
 156       (defun file-regular-p (file)
 157         (and (not (file-directory-p file))
 158              (not (file-symlink-p file))
 159              (file-exists-p file))))
 160   (or (fboundp 'face-list)
 161       (defun face-list (&rest args))))
 162
 163 (eval-and-compile
 164   (let ((case-fold-search t))
 165     (cond
 166      ((string-match "windows-nt\\|os/2\\|emx" (format "%s" system-type))
 167       (setq nnheader-file-name-translation-alist
 168             (append nnheader-file-name-translation-alist
 169                     '((?: . ?_)
 170                       (?+ . ?-))))))))
 171
 172 (defvar gnus-tmp-unread)
 173 (defvar gnus-tmp-replied)
 174 (defvar gnus-tmp-score-char)
 175 (defvar gnus-tmp-indentation)
 176 (defvar gnus-tmp-opening-bracket)
 177 (defvar gnus-tmp-lines)
 178 (defvar gnus-tmp-name)
 179 (defvar gnus-tmp-closing-bracket)
 180 (defvar gnus-tmp-subject-or-nil)
 181
 182 (defun gnus-ems-redefine ()
 183   (cond
 184    ((string-match "XEmacs\\|Lucid" emacs-version)
 185     (gnus-xmas-redefine))
 186
 187    ((boundp 'MULE)
 188     ;; Mule definitions
 189     (defalias 'gnus-truncate-string 'truncate-string)
 190
 191     (defvar gnus-summary-display-table nil
 192       "Display table used in summary mode buffers.")
 193     (fset 'gnus-cite-add-face 'gnus-mule-cite-add-face)
 194     (fset 'gnus-max-width-function 'gnus-mule-max-width-function)
 195
 196     (if (boundp 'gnus-check-before-posting)
 197         (setq gnus-check-before-posting
 198               (delq 'long-lines
 199                     (delq 'control-chars gnus-check-before-posting))))
 200
 201     (defun gnus-summary-line-format-spec ()
 202       (insert gnus-tmp-unread gnus-tmp-replied
 203               gnus-tmp-score-char gnus-tmp-indentation)
 204       (put-text-property
 205        (point)
 206        (progn
 207          (insert
 208           gnus-tmp-opening-bracket
 209           (format "%4d: %-20s"
 210                   gnus-tmp-lines
 211                   (if (> (length gnus-tmp-name) 20)
 212                       (truncate-string gnus-tmp-name 20)
 213                     gnus-tmp-name))
 214           gnus-tmp-closing-bracket)
 215          (point))
 216        gnus-mouse-face-prop gnus-mouse-face)
 217       (insert " " gnus-tmp-subject-or-nil "\n"))
 218     )))
 219
 220
 221 (provide 'gnus-ems)
 222
 223 ;; Local Variables:
 224 ;; byte-compile-warnings: '(redefine callargs)
 225 ;; End:
 226
 227 ;;; gnus-ems.el ends here