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