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