;;; gnus-ems.el --- functions for making Gnus work under different Emacsen
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
-;; Free Software Foundation, Inc.
+
+;; Copyright (C) 1995-2011 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(defvar gnus-down-mouse-2 [down-mouse-2])
(defvar gnus-widget-button-keymap nil)
(defvar gnus-mode-line-modified
- (if (or (featurep 'xemacs)
- (< emacs-major-version 20))
+ (if (featurep 'xemacs)
'("--**-" . "-----")
'("**" "--")))
(eval-and-compile
(autoload 'gnus-xmas-define "gnus-xmas")
- (autoload 'gnus-xmas-redefine "gnus-xmas")
- (autoload 'appt-select-lowest-window "appt")
- (autoload 'gnus-get-buffer-create "gnus")
- (autoload 'nnheader-find-etc-directory "nnheader"))
+ (autoload 'gnus-xmas-redefine "gnus-xmas"))
+(autoload 'gnus-get-buffer-create "gnus")
+(autoload 'nnheader-find-etc-directory "nnheader")
(autoload 'smiley-region "smiley")
-;; Fixme: shouldn't require message
-(autoload 'message-text-with-property "message")
(defun gnus-kill-all-overlays ()
"Delete all overlays in the current buffer."
(truncate-string-to-width valstr ,max-width)
valstr)))
-(eval-and-compile
- (defalias 'gnus-char-width
- (if (fboundp 'char-width)
- 'char-width
- (lambda (ch) 1)))) ;; A simple hack.
-
(eval-and-compile
(if (featurep 'xemacs)
(gnus-xmas-define)
(defvar gnus-mouse-face-prop 'mouse-face
"Property used for highlighting mouse regions.")))
-(eval-when-compile
- (defvar gnus-tmp-unread)
- (defvar gnus-tmp-replied)
- (defvar gnus-tmp-score-char)
- (defvar gnus-tmp-indentation)
- (defvar gnus-tmp-opening-bracket)
- (defvar gnus-tmp-lines)
- (defvar gnus-tmp-name)
- (defvar gnus-tmp-closing-bracket)
- (defvar gnus-tmp-subject-or-nil)
- (defvar gnus-check-before-posting)
- (defvar gnus-mouse-face)
- (defvar gnus-group-buffer))
+(defvar gnus-tmp-unread)
+(defvar gnus-tmp-replied)
+(defvar gnus-tmp-score-char)
+(defvar gnus-tmp-indentation)
+(defvar gnus-tmp-opening-bracket)
+(defvar gnus-tmp-lines)
+(defvar gnus-tmp-name)
+(defvar gnus-tmp-closing-bracket)
+(defvar gnus-tmp-subject-or-nil)
+(defvar gnus-check-before-posting)
+(defvar gnus-mouse-face)
+(defvar gnus-group-buffer)
(defun gnus-ems-redefine ()
(cond
gnus-mouse-face-prop gnus-mouse-face)
(insert " " gnus-tmp-subject-or-nil "\n")))))
+;; Clone of `appt-select-lowest-window' in appt.el.
+(defun gnus-select-lowest-window ()
+"Select the lowest window on the frame."
+ (let ((lowest-window (selected-window))
+ (bottom-edge (nth 3 (window-edges))))
+ (walk-windows (lambda (w)
+ (let ((next-bottom-edge (nth 3 (window-edges w))))
+ (when (< bottom-edge next-bottom-edge)
+ (setq bottom-edge next-bottom-edge
+ lowest-window w)))))
+ (select-window lowest-window)))
+
(defun gnus-region-active-p ()
"Say whether the region is active."
(and (boundp 'transient-mark-mode)
"Non-nil means the mark and region are currently active in this buffer."
mark-active) ; aliased to region-exists-p in XEmacs.
-(if (fboundp 'add-minor-mode)
- (defalias 'gnus-add-minor-mode 'add-minor-mode)
- (defun gnus-add-minor-mode (mode name map &rest rest)
- (set (make-local-variable mode) t)
- (unless (assq mode minor-mode-alist)
- (push `(,mode ,name) minor-mode-alist))
- (unless (assq mode minor-mode-map-alist)
- (push (cons mode map)
- minor-mode-map-alist))))
-
-(defun gnus-x-splash ()
- "Show a splash screen using a pixmap in the current buffer."
- (let ((dir (nnheader-find-etc-directory "gnus"))
- pixmap file height beg i)
- (save-excursion
- (switch-to-buffer (gnus-get-buffer-create gnus-group-buffer))
- (let ((buffer-read-only nil)
- width height)
- (erase-buffer)
- (when (and dir
- (file-exists-p (setq file
- (expand-file-name "x-splash" dir))))
- (let ((coding-system-for-read 'raw-text)
- default-enable-multibyte-characters)
- (with-temp-buffer
- (insert-file-contents file)
- (goto-char (point-min))
- (ignore-errors
- (setq pixmap (read (current-buffer)))))))
- (when pixmap
- (make-face 'gnus-splash)
- (setq height (/ (car pixmap) (frame-char-height))
- width (/ (cadr pixmap) (frame-char-width)))
- (set-face-foreground 'gnus-splash "Brown")
- (set-face-stipple 'gnus-splash pixmap)
- (insert-char ?\n (* (/ (window-height) 2 height) height))
- (setq i height)
- (while (> i 0)
- (insert-char ?\ (* (/ (window-width) 2 width) width))
- (setq beg (point))
- (insert-char ?\ width)
- (set-text-properties beg (point) '(face gnus-splash))
- (insert ?\n)
- (decf i))
- (goto-char (point-min))
- (sit-for 0))))))
+(autoload 'gnus-alive-p "gnus-util")
+(autoload 'mm-disable-multibyte "mm-util")
;;; Image functions.
(defun gnus-image-type-available-p (type)
(and (fboundp 'image-type-available-p)
- (image-type-available-p type)))
+ (image-type-available-p type)
+ (if (fboundp 'display-images-p)
+ (display-images-p)
+ t)))
(defun gnus-create-image (file &optional type data-p &rest props)
(let ((face (plist-get props :face)))
(when face
(setq props (plist-put props :foreground (face-foreground face)))
(setq props (plist-put props :background (face-background face))))
- (apply 'create-image file type data-p props)))
+ (ignore-errors
+ (apply 'create-image file type data-p props))))
</
projects / gnus / blobdiff