X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-xmas.el;h=1f6044162715827d16423395969ee671237f33b5;hb=3cde96ff1b7ea8086852ebf83b8ae8c1fa1c3118;hp=c4a728fb9ad5eeb868464e0935d3bd78d9bda11e;hpb=4c4edc2f2d1b3a8a3e858030e06940e9284c71d5;p=gnus diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el index c4a728fb9..1f6044162 100644 --- a/lisp/gnus-xmas.el +++ b/lisp/gnus-xmas.el @@ -1,7 +1,7 @@ ;;; gnus-xmas.el --- Gnus functions for XEmacs ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2005, 2006 Free Software Foundation, Inc. +;; 2005, 2006, 2008 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -10,7 +10,7 @@ ;; 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) +;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, @@ -39,7 +39,6 @@ (defvar menu-bar-mode (featurep 'menubar)) (require 'messagexmas) (require 'wid-edit) -(require 'timer-funcs) (defgroup gnus-xmas nil "XEmacsoid support for Gnus" @@ -103,6 +102,9 @@ Possibly the `etc' directory has not been installed."))) (defvar gnus-mouse-2) (defvar standard-display-table) (defvar gnus-tree-minimize-window) +;;`gnus-agent-mode' in gnus-agent.el will define it. +(defvar gnus-agent-summary-mode) +(defvar gnus-draft-mode) (defun gnus-xmas-highlight-selected-summary () ;; Highlight selected article in summary buffer @@ -346,6 +348,38 @@ call it with the value of the `gnus-data' text property." (event-to-character event)) event))) +(defun gnus-xmas-article-describe-bindings (&optional prefix) + "Show a list of all defined keys, and their definitions. +The optional argument PREFIX, if non-nil, should be a key sequence; +then we display only bindings that start with that prefix." + (interactive) + (gnus-article-check-buffer) + (let ((keymap (copy-keymap gnus-article-mode-map)) + (map (copy-keymap gnus-article-send-map)) + (sumkeys (where-is-internal 'gnus-article-read-summary-keys)) + agent draft) + (define-key keymap "S" map) + (set-keymap-default-binding map nil) + (with-current-buffer gnus-article-current-summary + (let ((def (key-binding "S")) + gnus-pick-mode) + (set-keymap-parent map (if (symbolp def) + (symbol-value def) + def)) + (dolist (key sumkeys) + (when (setq def (key-binding key)) + (define-key keymap key def)))) + (when (boundp 'gnus-agent-summary-mode) + (setq agent gnus-agent-summary-mode)) + (when (boundp 'gnus-draft-mode) + (setq draft gnus-draft-mode))) + (with-temp-buffer + (setq major-mode 'gnus-article-mode) + (use-local-map keymap) + (set (make-local-variable 'gnus-agent-summary-mode) agent) + (set (make-local-variable 'gnus-draft-mode) draft) + (describe-bindings prefix)))) + (defun gnus-xmas-define () (setq gnus-mouse-2 [button2]) (setq gnus-mouse-3 [button3]) @@ -368,7 +402,12 @@ call it with the value of the `gnus-data' text property." (t (defalias 'gnus-characterp 'characterp))) - (defalias 'gnus-make-overlay 'make-extent) + (defalias 'gnus-make-overlay + (lambda (beg end &optional buffer front-advance rear-advance) + "Create a new overlay with range BEG to END in BUFFER. +FRONT-ADVANCE and REAR-ADVANCE are ignored." + (make-extent beg end buffer))) + (defalias 'gnus-delete-overlay 'delete-extent) (defalias 'gnus-overlay-put 'set-extent-property) (defalias 'gnus-move-overlay 'gnus-xmas-move-overlay) @@ -430,10 +469,14 @@ call it with the value of the `gnus-data' text property." (defalias 'gnus-mark-active-p 'region-exists-p) (defalias 'gnus-annotation-in-region-p 'gnus-xmas-annotation-in-region-p) (defalias 'gnus-mime-button-menu 'gnus-xmas-mime-button-menu) + (defalias 'gnus-mime-security-button-menu + 'gnus-xmas-mime-security-button-menu) (defalias 'gnus-image-type-available-p 'gnus-xmas-image-type-available-p) (defalias 'gnus-put-image 'gnus-xmas-put-image) (defalias 'gnus-create-image 'gnus-xmas-create-image) (defalias 'gnus-remove-image 'gnus-xmas-remove-image) + (defalias 'gnus-article-describe-bindings + 'gnus-xmas-article-describe-bindings) ;; These ones are not defcutom'ed, sometimes not even defvar'ed. They ;; probably should. If that is done, the code below should then be moved @@ -784,6 +827,21 @@ XEmacs compatibility workaround." (goto-char (event-point event)) (funcall (event-function response) (event-object response)))) +(defun gnus-xmas-mime-security-button-menu (event prefix) + "Construct a context-sensitive menu of security commands." + (interactive "e\nP") + (let ((response + (get-popup-menu-response + `("Security Part" + ,@(delq nil + (mapcar (lambda (c) + (unless (eq (car c) 'undefined) + `[,(caddr c) ,(car c) t])) + gnus-mime-security-button-commands)))))) + (set-buffer (event-buffer event)) + (goto-char (event-point event)) + (funcall (event-function response) (event-object response)))) + (defun gnus-group-add-icon () "Add an icon to the current line according to `gnus-group-icon-list'." (let* ((p (point)) @@ -824,7 +882,7 @@ XEmacs compatibility workaround." file))) (if glyph (progn - (mapcar 'delete-annotation (annotations-at myend)) + (mapc 'delete-annotation (annotations-at myend)) (let ((ext (make-extent mystart myend)) (ant (make-annotation glyph myend 'text))) ;; set text extent params @@ -857,7 +915,9 @@ XEmacs compatibility workaround." gnus-mailing-list-menu)) (defun gnus-xmas-image-type-available-p (type) - (and window-system + (and (if (fboundp 'display-images-p) + (display-images-p) + window-system) (featurep (if (eq type 'pbm) 'xbm type)))) (defun gnus-xmas-create-image (file &optional type data-p &rest props)