X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-ems.el;h=46493064fc694cc4a2f857de4039d1bf173022b7;hb=f65172de618572102138a4dabae64d91011d15f6;hp=06bdfa219c217be68813ae40b760e3c89d655b0b;hpb=47070be368580bb27b879aa8096af7a08f2049a9;p=gnus diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index 06bdfa219..46493064f 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -1,5 +1,5 @@ ;;; gnus-ems.el --- functions for making Gnus work under different Emacsen -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -26,7 +26,9 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile + (require 'cl) + (require 'ring)) ;;; Function aliases later to be redefined for XEmacs usage. @@ -47,8 +49,15 @@ (if (featurep 'xemacs) (autoload 'gnus-smiley-display "smiley") - (autoload 'gnus-smiley-display "smiley-ems") ; override XEmacs version -) + (autoload 'gnus-smiley-display "smiley-ems")) ; override XEmacs version + +(defun gnus-kill-all-overlays () + "Delete all overlays in the current buffer." + (let* ((overlayss (overlay-lists)) + (buffer-read-only nil) + (overlays (delq nil (nconc (car overlayss) (cdr overlayss))))) + (while overlays + (delete-overlay (pop overlays))))) ;;; Mule functions. @@ -60,6 +69,12 @@ (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) @@ -75,7 +90,10 @@ (append nnheader-file-name-translation-alist (mapcar (lambda (c) (cons c ?_)) '(?: ?* ?\" ?< ?> ??)) - '((?+ . ?-)))))))) + (if (string-match "windows-nt\\|cygwin32" + (symbol-name system-type)) + nil + '((?+ . ?-))))))))) (defvar gnus-tmp-unread) (defvar gnus-tmp-replied) @@ -86,6 +104,7 @@ (defvar gnus-tmp-name) (defvar gnus-tmp-closing-bracket) (defvar gnus-tmp-subject-or-nil) +(defvar gnus-check-before-posting) (defun gnus-ems-redefine () (cond @@ -198,12 +217,15 @@ "Length of the ring used for `gnus-article-xface-ring-internal'.") (defvar gnus-article-compface-xbm - (eq 0 (string-match "#define" (shell-command-to-string "uncompface -X"))) + (condition-case () + (eq 0 (string-match "#define" + (shell-command-to-string "uncompface -X"))) + (error nil)) "Non-nil means the compface program supports the -X option. That produces XBM output.") -(defun gnus-article-display-xface (beg end) - "Display an XFace header from between BEG and END in the current article. +(defun gnus-article-display-xface (beg end &optional buffer) + "Display an XFace header from between BEG and END in BUFFER. Requires support for images in your Emacs and the external programs `uncompface', and `icontopbm'. On a GNU/Linux system these might be in packages with names like `compface' or `faces-xface' and @@ -221,7 +243,10 @@ for XEmacs." (make-ring gnus-article-xface-ring-size))) (save-excursion (let* ((cur (current-buffer)) - (data (buffer-substring beg end)) + (data (if buffer + (with-current-buffer buffer + (buffer-substring beg end)) + (buffer-substring beg end))) (image (cdr-safe (assoc data (ring-elements gnus-article-xface-ring-internal)))) default-enable-multibyte-characters) @@ -262,12 +287,22 @@ for XEmacs." (when image (goto-char (point-min)) (re-search-forward "^From:" nil 'move) + (while (get-text-property (point) 'display) + (goto-char (next-single-property-change (point) 'display))) (insert-image image)))))) -(provide 'gnus-ems) +;;; Image functions. -;; Local Variables: -;; byte-compile-warnings: '(redefine callargs) -;; End: +(defun gnus-image-type-available-p (type) + (and (fboundp 'image-type-available-p) + (image-type-available-p type))) + +(defun gnus-create-image (file) + (create-image file)) + +(defun gnus-put-image (glyph) + (put-image glyph (point))) + +(provide 'gnus-ems) ;;; gnus-ems.el ends here