X-Git-Url: https://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-ems.el;h=b4a2fe960c67b86d58d484a5708632f62e27e2f5;hp=11d8d7cd82e13e9c888274b74dea2b3574ce55da;hb=ba2fe997b36918f5ed20351fe6871a9931f5eb09;hpb=6153f31672787c5326f5993af6c34397c76b8a52 diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index 11d8d7cd8..b4a2fe960 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -1,17 +1,17 @@ ;;; gnus-ems.el --- functions for making Gnus work under different Emacsen ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc. +;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; 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 @@ -19,9 +19,7 @@ ;; 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -44,10 +42,10 @@ (eval-and-compile (autoload 'gnus-xmas-define "gnus-xmas") - (autoload 'gnus-xmas-redefine "gnus-xmas") - (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") (defun gnus-kill-all-overlays () @@ -74,19 +72,18 @@ (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 @@ -162,6 +159,9 @@ "Non-nil means the mark and region are currently active in this buffer." mark-active) ; aliased to region-exists-p in XEmacs. +(autoload 'gnus-alive-p "gnus-util") +(autoload 'mm-disable-multibyte "mm-util") + (defun gnus-x-splash () "Show a splash screen using a pixmap in the current buffer." (interactive) @@ -171,15 +171,16 @@ (interactive-p)) "*gnus-x-splash*" gnus-group-buffer))) - (let ((inhibit-read-only nil) + (let ((inhibit-read-only t) (file (nnheader-find-etc-directory "images/gnus/x-splash" t)) pixmap fcw fch width height fringes sbars left yoffset top ls) (erase-buffer) + (sit-for 0) ;; Necessary for measuring the window size correctly. (when (and file (ignore-errors - (let ((coding-system-for-read 'raw-text) - default-enable-multibyte-characters) + (let ((coding-system-for-read 'raw-text)) (with-temp-buffer + (mm-disable-multibyte) (insert-file-contents file) (goto-char (point-min)) (setq pixmap (read (current-buffer))))))) @@ -199,7 +200,9 @@ (setq sbars (cons (/ (or (frame-parameter nil 'scroll-bar-width) 14) fcw) - 0)))) + 0))) + (t + (setq sbars '(0 . 0)))) (setq left (- (* (round (/ (1- (/ (+ (window-width) (car sbars) (cdr sbars) (/ (+ (or (car fringes) 0) @@ -211,7 +214,8 @@ (car sbars) (/ (or (car fringes) 0) fcw)) yoffset (cadr (window-edges)) - top (max 0 (- (* (max (if (and tool-bar-mode + top (max 0 (- (* (max (if (and (boundp 'tool-bar-mode) + tool-bar-mode (not (featurep 'gtk)) (eq (frame-first-window) (selected-window))) @@ -268,11 +272,12 @@ (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)))) (defun gnus-put-image (glyph &optional string category) (let ((point (point))) - (insert-image glyph (or string " ")) + (insert-image glyph (or string "*")) (put-text-property point (point) 'gnus-image-category category) (unless string (put-text-property (1- (point)) (point) @@ -301,7 +306,47 @@ (setq start end end nil)))))) +(eval-and-compile + (if (fboundp 'set-process-plist) + (progn + (defalias 'gnus-set-process-plist 'set-process-plist) + (defalias 'gnus-process-plist 'process-plist) + (defalias 'gnus-process-get 'process-get) + (defalias 'gnus-process-put 'process-put)) + (defun gnus-set-process-plist (process plist) + "Replace the plist of PROCESS with PLIST. Returns PLIST." + (put 'gnus-process-plist-internal process plist)) + + (defun gnus-process-plist (process) + "Return the plist of PROCESS." + ;; This form works but can't prevent the plist data from + ;; growing infinitely. + ;;(get 'gnus-process-plist-internal process) + (let* ((plist (symbol-plist 'gnus-process-plist-internal)) + (tem (memq process plist))) + (prog1 + (cadr tem) + ;; Remove it from the plist data. + (when tem + (if (eq plist tem) + (progn + (setcar plist (caddr plist)) + (setcdr plist (or (cdddr plist) '(nil)))) + (setcdr (nthcdr (- (length plist) (length tem) 1) plist) + (cddr tem))))))) + + (defun gnus-process-get (process propname) + "Return the value of PROCESS' PROPNAME property. +This is the last value stored with `(gnus-process-put PROCESS PROPNAME VALUE)'." + (plist-get (gnus-process-plist process) propname)) + + (defun gnus-process-put (process propname value) + "Change PROCESS' PROPNAME property to VALUE. +It can be retrieved with `(gnus-process-get PROCESS PROPNAME)'." + (gnus-set-process-plist process + (plist-put (gnus-process-plist process) + propname value))))) + (provide 'gnus-ems) -;;; arch-tag: e7360b45-14b5-4171-aa39-69a44aed3cdb ;;; gnus-ems.el ends here