X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-ems.el;h=f1d43475b42919f026259ee293db8075cece9060;hb=851278bf56a0156a4dd5896e9959f63e33d07ee2;hp=22a5e28beaabd150f2b3b36c5910f7aad49d45b3;hpb=866d052667412dc9acb651a923de0a02b5bc5d72;p=gnus diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index 22a5e28be..f1d43475b 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -1,17 +1,16 @@ ;;; 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. +;; Copyright (C) 1995-2015 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 +18,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 +41,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 +71,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,103 +158,25 @@ "Non-nil means the mark and region are currently active in this buffer." mark-active) ; aliased to region-exists-p in XEmacs. -(defun gnus-x-splash () - "Show a splash screen using a pixmap in the current buffer." - (interactive) - (switch-to-buffer (gnus-get-buffer-create (if (or (gnus-alive-p) - (interactive-p)) - "*gnus-x-splash*" - gnus-group-buffer))) - (let ((inhibit-read-only nil) - (file (nnheader-find-etc-directory "images/gnus/x-splash" t)) - pixmap fcw fch width height fringes sbars left yoffset top) - (erase-buffer) - (when (and file - (ignore-errors - (let ((coding-system-for-read 'raw-text) - default-enable-multibyte-characters) - (with-temp-buffer - (insert-file-contents file) - (goto-char (point-min)) - (setq pixmap (read (current-buffer))))))) - (setq fcw (float (frame-char-width)) - fch (float (frame-char-height)) - width (/ (car pixmap) fcw) - height (/ (cadr pixmap) fch) - fringes (if (fboundp 'window-fringes) - (eval '(window-fringes)) - '(10 11 nil)) - sbars (/ (or (frame-parameter nil 'scroll-bar-width) 14) fcw)) - (setq sbars (if (eq (frame-parameter nil 'vertical-scroll-bars) 'right) - (cons 0 sbars) - (cons sbars 0))) - (setq left (- (* (round (/ (1- (/ (+ (window-width) - (car sbars) (cdr sbars) - (/ (+ (or (car fringes) 0) - (or (cadr fringes) 0)) - fcw)) - width)) - 2)) - width) - (car sbars) - (/ (or (car fringes) 0) fcw)) - yoffset (cadr (window-edges)) - top (max 0 (- (* (max (if (and tool-bar-mode - (not (featurep 'gtk)) - (eq (frame-first-window) - (selected-window))) - 1 0) - (round (/ (1- (/ (+ (1- (window-height)) - (* 2 yoffset)) - height)) - 2))) - height) - yoffset - (/ (* (or line-spacing 0) 2) fch))) - height (- height (/ (or line-spacing 0) fch))) - (cond ((>= top 1) - (insert (propertize - " " - 'display `(space :width 0 :ascent 100)) - "\n" - (propertize - " " - 'display `(space :width 0 :height ,(1- top) :ascent 100)) - "\n")) - ((> top 0) - (insert (propertize - " " - 'display `(space :width 0 :height ,top :ascent 100)) - "\n"))) - (if (and (> width 0) (> left 0)) - (insert (propertize - " " - 'display `(space :width ,left :height ,height :ascent 0))) - (setq width (+ width left))) - (when (> width 0) - (insert (propertize - " " - 'display `(space :width ,width :height ,height :ascent 0) - 'face `(gnus-splash :stipple ,pixmap)))) - (goto-char (if (zerop top) (1- (point)) (point-min))) - (redraw-frame (selected-frame)) - (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) (if (fboundp 'display-images-p) (display-images-p) - t))) + t) + (image-type-available-p type))) (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)))) (defun gnus-put-image (glyph &optional string category) (let ((point (point))) @@ -291,7 +209,58 @@ (setq start end end nil)))))) +(defmacro gnus-string-mark-left-to-right (string) + (if (fboundp 'bidi-string-mark-left-to-right) + `(bidi-string-mark-left-to-right ,string) + string)) + +(eval-and-compile + ;; XEmacs does not have window-inside-pixel-edges + (defalias 'gnus-window-inside-pixel-edges + (if (fboundp 'window-inside-pixel-edges) + 'window-inside-pixel-edges + 'window-pixel-edges)) + + (if (or (featurep 'emacs) (fboundp 'set-process-plist)) + (progn ; these exist since Emacs 22.1 + (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