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  '(cond
  38    ((string-match "XEmacs\\|Lucid" emacs-version)
  39     ;; XEmacs definitions.
  40
  41     (setq gnus-mouse-2 [button2])
  42     (setq gnus-easymenu 'auc-menu)
  43
  44     (or (memq 'underline (list-faces))
  45         (funcall (intern "make-face") 'underline))
  46     ;; Must avoid calling set-face-underline-p directly, because it
  47     ;; is a defsubst in emacs19, and will make the .elc files non
  48     ;; portable!
  49     (or (face-differs-from-default-p 'underline)
  50         (funcall 'set-face-underline-p 'underline t))
  51     (or (fboundp 'set-text-properties)
  52         (defun set-text-properties (start end props &optional buffer)
  53           (if props
  54               (put-text-property start end (car props) (cadr props) buffer)
  55             (remove-text-properties start end ()))))
  56
  57     (or (fboundp 'make-overlay) (fset 'make-overlay 'make-extent))
  58     (or (fboundp 'overlay-put) (fset 'overlay-put 'set-extent-property))
  59     (or (fboundp 'move-overlay)
  60         (defun move-overlay (extent start end &optional buffer)
  61           (set-extent-endpoints extent start end)))
  62     (or (boundp 'standard-display-table) (setq standard-display-table nil))
  63     (or (boundp 'read-event) (fset 'read-event 'next-command-event))
  64
  65     (if (not gnus-visual)
  66         ()
  67       (setq gnus-group-mode-hook
  68             (cons
  69              (lambda ()
  70                (easy-menu-add gnus-group-reading-menu)
  71                (easy-menu-add gnus-group-group-menu)
  72                (easy-menu-add gnus-group-post-menu)
  73                (easy-menu-add gnus-group-misc-menu)
  74                (gnus-install-mouse-tracker))
  75              gnus-group-mode-hook))
  76       (setq gnus-summary-mode-hook
  77             (cons
  78              (lambda ()
  79                (easy-menu-add gnus-summary-mark-menu)
  80                (easy-menu-add gnus-summary-move-menu)
  81                (easy-menu-add gnus-summary-article-menu)
  82                (easy-menu-add gnus-summary-thread-menu)
  83                (easy-menu-add gnus-summary-misc-menu)
  84                (easy-menu-add gnus-summary-post-menu)
  85                (easy-menu-add gnus-summary-kill-menu)
  86                (gnus-install-mouse-tracker))
  87              gnus-summary-mode-hook))
  88       (setq gnus-article-mode-hook
  89             (cons
  90              (lambda ()
  91                (easy-menu-add gnus-article-article-menu)
  92                (easy-menu-add gnus-article-treatment-menu))
  93              gnus-article-mode-hook)))
  94
  95     (defun gnus-install-mouse-tracker ()
  96       (require 'mode-motion)
  97       (setq mode-motion-hook 'mode-motion-highlight-line)))
  98
  99    ((and (not (string-match "28.9" emacs-version))
 100          (not (string-match "29" emacs-version)))
 101     (setq gnus-hidden-properties '(invisible t)))
 102
 103    ((boundp 'MULE)
 104     (provide 'gnusutil))
 105
 106    ))
 107
 108 (eval-and-compile
 109   (cond
 110    ((not window-system)
 111     (defun gnus-dummy-func (&rest args))
 112     (let ((funcs '(mouse-set-point set-face-foreground
 113                                    set-face-background x-popup-menu)))
 114       (while funcs
 115         (or (fboundp (car funcs))
 116             (fset (car funcs) 'gnus-dummy-func))
 117         (setq funcs (cdr funcs))))))
 118   (or (fboundp 'file-regular-p)
 119       (defun file-regular-p (file)
 120         (and (not (file-directory-p file))
 121              (not (file-symlink-p file))
 122              (file-exists-p file))))
 123   (or (fboundp 'face-list)
 124       (defun face-list (&rest args)))
 125   )
 126
 127 (defun gnus-ems-redefine ()
 128   (cond
 129    ((string-match "XEmacs\\|Lucid" emacs-version)
 130     ;; XEmacs definitions.
 131     (fset 'gnus-set-mouse-face (lambda (string) string))
 132
 133     (defun gnus-summary-make-display-table ()
 134       ;; We start from the standard display table, if any.
 135       (let* ((table (window-display-table)))
 136         (and (not table)
 137              (setq table (make-vector 261 ())))
 138         ;; Nix out all the control chars...
 139         (let ((i 32))
 140           (while (>= (setq i (1- i)) 0)
 141             (aset table i [??])))
 142         ;; ... but not newline, of course.
 143         (aset table ?\n nil)
 144         ;; We nix out any glyphs over 126 that are not set already.
 145         (let ((i 256))
 146           (while (>= (setq i (1- i)) 127)
 147             (or (aref table i)
 148                 (aset table i [??]))))
 149         (set-window-display-table (get-buffer-window (current-buffer)) table)))
 150
 151     (defun gnus-highlight-selected-summary ()
 152       ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
 153       ;; Highlight selected article in summary buffer
 154       (if gnus-summary-selected-face
 155           (save-excursion
 156             (let* ((beg (progn (beginning-of-line) (point)))
 157                    (end (progn (end-of-line) (point)))
 158                    (to (max 1 (1- (or (previous-single-property-change
 159                                        end 'mouse-face nil beg) end))))
 160                    (from (1+ (or (next-single-property-change
 161                                   beg 'mouse-face nil end) beg))))
 162               (if (< to beg)
 163                   (progn
 164                     (setq from beg)
 165                     (setq to end)))
 166               (if gnus-newsgroup-selected-overlay
 167                   (delete-extent gnus-newsgroup-selected-overlay))
 168               (setq gnus-newsgroup-selected-overlay
 169                     (make-extent from to))
 170               (set-extent-face gnus-newsgroup-selected-overlay
 171                                gnus-summary-selected-face)))))
 172
 173     )
 174    ((boundp 'MULE)
 175     ;; Mule definitions
 176     (defun top-short-string (str width)
 177       "Return a substring of STRING, starting at top and its length is
 178 equal or smaller than WIDTH. This function doesn't split in the middle
 179 of multi-octet character. [tl-str]"
 180       (substring str 0
 181                  (let ((i 0) (w 0) chr (len (length str)))
 182                    (catch 'label
 183                      (while (< i len)
 184                        (setq chr (elt str i))
 185                        (setq w (+ w (char-width chr)))
 186                        (if (> w width)
 187                            (throw 'label i))
 188                        (setq i (+ i (char-bytes chr)))
 189                        )
 190                      i))
 191                  ))
 192
 193     (defun gnus-format-max-width (form length)
 194       (let* ((val (eval form))
 195              (valstr (if (numberp val) (int-to-string val) val)))
 196         (if (> (length valstr) length)
 197             (top-short-string valstr length)
 198           valstr)))
 199
 200     (defun gnus-summary-make-display-table ())
 201     )
 202    ))
 203
 204 (provide 'gnus-ems)
 205
 206 ;; Local Variables:
 207 ;; byte-compile-warnings: nil
 208 ;; End:
 209
 210 ;;; gnus-ems.el ends here