X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-ems.el;h=2438b311f6af58da73573a21703228b3adede778;hb=55bc8c3145813effa0a57df9326c683eb77dbbe6;hp=62b1e2ae7ad2b2fc36adfd892e5a56a9110f744f;hpb=d321f3500cf2b4c24b4540faa6b281339b378a32;p=gnus diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index 62b1e2ae7..2438b311f 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -1,7 +1,7 @@ ;;; gnus-ems.el --- functions for making Gnus work under different Emacsen -;; Copyright (C) 1995 Free Software Foundation, Inc. +;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. -;; Author: Lars Magne Ingebrigtsen +;; Author: Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. @@ -17,96 +17,79 @@ ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. +;; 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. ;;; Commentary: ;;; Code: +(eval-when-compile (require 'cl)) + +;;; Function aliases later to be redefined for XEmacs usage. + +(defvar gnus-xemacs (string-match "XEmacs\\|Lucid" emacs-version) + "Non-nil if running under XEmacs.") + (defvar gnus-mouse-2 [mouse-2]) -(defvar gnus-easymenu 'easymenu) -(defvar gnus-group-mode-hook ()) -(defvar gnus-summary-mode-hook ()) -(defvar gnus-article-mode-hook ()) +(defvar gnus-mouse-3 [mouse-3]) +(defvar gnus-down-mouse-2 [down-mouse-2]) +(defvar gnus-widget-button-keymap nil) +(defvar gnus-mode-line-modified + (if (or gnus-xemacs + (< emacs-major-version 20)) + '("--**-" . "-----") + '("**" "--"))) + +(eval-and-compile + (autoload 'gnus-xmas-define "gnus-xmas") + (autoload 'gnus-xmas-redefine "gnus-xmas") + (autoload 'appt-select-lowest-window "appt")) + +;;; Mule functions. + +(defun gnus-mule-cite-add-face (number prefix face) + ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line. + (when face + (let ((inhibit-point-motion-hooks t) + from to) + (goto-line number) + (unless (eobp) ; Sometimes things become confused (broken). + (if (boundp 'MULE) + (forward-char (chars-in-string prefix)) + (forward-char (length prefix))) + (skip-chars-forward " \t") + (setq from (point)) + (end-of-line 1) + (skip-chars-backward " \t") + (setq to (point)) + (when (< from to) + (push (setq overlay (gnus-make-overlay from to)) + gnus-cite-overlay-list) + (gnus-overlay-put (gnus-make-overlay from to) 'face face)))))) + +(defun gnus-mule-max-width-function (el max-width) + (` (let* ((val (eval (, el))) + (valstr (if (numberp val) + (int-to-string val) val))) + (if (> (length valstr) (, max-width)) + (truncate-string-to-width valstr (, max-width)) + valstr)))) + +(eval-and-compile + (if (string-match "XEmacs\\|Lucid" emacs-version) + nil -;; We do not byte-compile this file, because error messages are such a -;; bore. + (defvar gnus-mouse-face-prop 'mouse-face + "Property used for highlighting mouse regions.")) -(eval - '(cond + (cond ((string-match "XEmacs\\|Lucid" emacs-version) - ;; XEmacs definitions. - - (setq gnus-mouse-2 [button2]) - (setq gnus-easymenu 'auc-menu) - - (or (memq 'underline (list-faces)) - (funcall (intern "make-face") 'underline)) - ;; Must avoid calling set-face-underline-p directly, because it - ;; is a defsubst in emacs19, and will make the .elc files non - ;; portable! - (or (face-differs-from-default-p 'underline) - (funcall 'set-face-underline-p 'underline t)) - (or (fboundp 'set-text-properties) - (defun set-text-properties (start end props &optional buffer) - (if props - (put-text-property start end (car props) (cdr props) buffer) - (remove-text-properties start end ())))) - - (or (fboundp 'make-overlay) (fset 'make-overlay 'make-extent)) - (or (fboundp 'overlay-put) (fset 'overlay-put 'set-extent-property)) - (or (fboundp 'move-overlay) - (defun move-overlay (extent start end &optional buffer) - (set-extent-endpoints extent start end))) - (or (boundp 'standard-display-table) (setq standard-display-table nil)) - (or (boundp 'read-event) (fset 'read-event 'next-command-event)) - - (if (not gnus-visual) - () - (setq gnus-group-mode-hook - (cons - (lambda () - (easy-menu-add gnus-group-reading-menu) - (easy-menu-add gnus-group-group-menu) - (easy-menu-add gnus-group-post-menu) - (easy-menu-add gnus-group-misc-menu) - (gnus-install-mouse-tracker)) - gnus-group-mode-hook)) - (setq gnus-summary-mode-hook - (cons - (lambda () - (easy-menu-add gnus-summary-mark-menu) - (easy-menu-add gnus-summary-move-menu) - (easy-menu-add gnus-summary-article-menu) - (easy-menu-add gnus-summary-thread-menu) - (easy-menu-add gnus-summary-misc-menu) - (easy-menu-add gnus-summary-post-menu) - (easy-menu-add gnus-summary-kill-menu) - (gnus-install-mouse-tracker)) - gnus-summary-mode-hook)) - (setq gnus-article-mode-hook - (cons - (lambda () - (easy-menu-add gnus-article-article-menu) - (easy-menu-add gnus-article-treatment-menu)) - gnus-article-mode-hook))) - - (defun gnus-install-mouse-tracker () - (require 'mode-motion) - (setq mode-motion-hook 'mode-motion-highlight-line))) - - ((and (not (string-match "28.9" emacs-version)) - (not (string-match "29" emacs-version))) - (setq gnus-hidden-properties '(invisible t)) - (or (fboundp 'buffer-substring-no-properties) - (defun buffer-substring-no-properties (beg end) - (format "%s" (buffer-substring beg end))))) - + (gnus-xmas-define)) + ((boundp 'MULE) - (provide 'gnusutil)) - - )) + (provide 'gnusutil)))) (eval-and-compile (cond @@ -115,84 +98,139 @@ (let ((funcs '(mouse-set-point set-face-foreground set-face-background x-popup-menu))) (while funcs - (or (fboundp (car funcs)) - (fset (car funcs) 'gnus-dummy-func)) - (setq funcs (cdr funcs)))))) - (or (fboundp 'file-regular-p) - (defun file-regular-p (file) - (and (not (file-directory-p file)) - (not (file-symlink-p file)) - (file-exists-p file)))) - (or (fboundp 'face-list) - (defun face-list (&rest args))) - ) + (unless (fboundp (car funcs)) + (fset (car funcs) 'gnus-dummy-func)) + (setq funcs (cdr funcs))))))) + +(eval-and-compile + (let ((case-fold-search t)) + (cond + ((string-match "windows-nt\\|os/2\\|emx" (symbol-name system-type)) + (setq nnheader-file-name-translation-alist + (append nnheader-file-name-translation-alist + '((?: . ?_) + (?+ . ?-)))))))) + +(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) (defun gnus-ems-redefine () - (cond + (cond ((string-match "XEmacs\\|Lucid" emacs-version) - ;; XEmacs definitions. - (fset 'gnus-set-mouse-face (lambda (string) string)) - - (defun gnus-summary-make-display-table () - ) - - (defun gnus-highlight-selected-summary () - ;; Added by Per Abrahamsen . - ;; Highlight selected article in summary buffer - (if gnus-summary-selected-face - (save-excursion - (let* ((beg (progn (beginning-of-line) (point))) - (end (progn (end-of-line) (point))) - (to (max 1 (1- (or (previous-single-property-change - end 'mouse-face nil beg) end)))) - (from (1+ (or (next-single-property-change - beg 'mouse-face nil end) beg)))) - (if (< to beg) - (progn - (setq from beg) - (setq to end))) - (if gnus-newsgroup-selected-overlay - (delete-extent gnus-newsgroup-selected-overlay)) - (setq gnus-newsgroup-selected-overlay - (make-extent from to)) - (set-extent-face gnus-newsgroup-selected-overlay - gnus-summary-selected-face))))) - - ) - ((boundp 'MULE) - ;; Mule definitions - (defun top-short-string (str width) - "Return a substring of STRING, starting at top and its length is -equal or smaller than WIDTH. This function doesn't split in the middle -of multi-octet character. [tl-str]" - (substring str 0 - (let ((i 0) (w 0) chr (len (length str))) - (catch 'label - (while (< i len) - (setq chr (elt str i)) - (setq w (+ w (char-width chr))) - (if (> w width) - (throw 'label i)) - (setq i (+ i (char-bytes chr))) - ) - i)) - )) - - (defun gnus-format-max-width (form length) - (let* ((val (eval form)) - (valstr (if (numberp val) (int-to-string val) val))) - (if (> (length valstr) length) - (top-short-string valstr length) - valstr))) + (gnus-xmas-redefine)) + + ((featurep 'mule) + ;; Mule and new Emacs definitions + + ;; [Note] Now there are three kinds of mule implementations, + ;; original MULE, XEmacs/mule and beta version of Emacs including + ;; some mule features. Unfortunately these API are different. In + ;; particular, Emacs (including original MULE) and XEmacs are + ;; quite different. + ;; Predicates to check are following: + ;; (boundp 'MULE) is t only if MULE (original; anything older than + ;; Mule 2.3) is running. + ;; (featurep 'mule) is t when every mule variants are running. + + ;; These implementations may be able to share between original + ;; MULE and beta version of new Emacs. In addition, it is able to + ;; detect XEmacs/mule by (featurep 'mule) and to check variable + ;; `emacs-version'. In this case, implementation for XEmacs/mule + ;; may be able to share between XEmacs and XEmacs/mule. + + (defvar gnus-summary-display-table nil + "Display table used in summary mode buffers.") + (fset 'gnus-cite-add-face 'gnus-mule-cite-add-face) + (fset 'gnus-max-width-function 'gnus-mule-max-width-function) + (fset 'gnus-summary-set-display-table (lambda ())) - (defun gnus-summary-make-display-table ()) - ) - )) + (when (boundp 'gnus-check-before-posting) + (setq gnus-check-before-posting + (delq 'long-lines + (delq 'control-chars gnus-check-before-posting)))) + + (defun gnus-summary-line-format-spec () + (insert gnus-tmp-unread gnus-tmp-replied + gnus-tmp-score-char gnus-tmp-indentation) + (put-text-property + (point) + (progn + (insert + gnus-tmp-opening-bracket + (format "%4d: %-20s" + gnus-tmp-lines + (if (> (length gnus-tmp-name) 20) + (truncate-string-to-width gnus-tmp-name 20) + gnus-tmp-name)) + gnus-tmp-closing-bracket) + (point)) + gnus-mouse-face-prop gnus-mouse-face) + (insert " " gnus-tmp-subject-or-nil "\n")) + ))) + +(defun gnus-region-active-p () + "Say whether the region is active." + (and (boundp 'transient-mark-mode) + transient-mark-mode + (boundp 'mark-active) + mark-active)) + +(defun gnus-add-minor-mode (mode name map) + (if (fboundp 'add-minor-mode) + (add-minor-mode mode name map) + (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)) + (erase-buffer) + (when (and dir + (file-exists-p (setq file (concat dir "x-splash")))) + (with-temp-buffer + (insert-file-contents file) + (goto-char (point-min)) + (ignore-errors + (setq pixmap (read (current-buffer)))))) + (when pixmap + (erase-buffer) + (unless (facep 'gnus-splash) + (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) 1) 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)))))) (provide 'gnus-ems) ;; Local Variables: -;; byte-compile-warnings: nil +;; byte-compile-warnings: '(redefine callargs) ;; End: ;;; gnus-ems.el ends here