X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgmm-utils.el;h=459a7866127a9f6e18e562a5079c4a6b436d4f5a;hb=75e9b45e4f20d65e8b0dcb85520da245d66a11c6;hp=1d9f30c273c97a9ec10317cf4c8d060cf33d33bf;hpb=063c5b9963c05b4f69ef98c1d10930e03c5127ce;p=gnus diff --git a/lisp/gmm-utils.el b/lisp/gmm-utils.el index 1d9f30c27..459a78661 100644 --- a/lisp/gmm-utils.el +++ b/lisp/gmm-utils.el @@ -1,26 +1,24 @@ ;;; gmm-utils.el --- Utility functions for Gnus, Message and MML -;; Copyright (C) 2006, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2006-2014 Free Software Foundation, Inc. ;; Author: Reiner Steib ;; 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 3, 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 -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; 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: @@ -30,10 +28,8 @@ ;;; Code: -(require 'wid-edit) - (defgroup gmm nil - "Utility functions for Gnus, Message and MML" + "Utility functions for Gnus, Message and MML." :prefix "gmm-" :version "22.1" ;; Gnus 5.10.9 :group 'lisp) @@ -43,7 +39,7 @@ (defcustom gmm-verbose 7 "Integer that says how verbose gmm should be. The higher the number, the more messages will flash to say what -it done. At zero, it will be totally mute; at five, it will +it did. At zero, it will be totally mute; at five, it will display most important messages; and at ten, it will keep on jabbering all the time." :type 'integer @@ -67,9 +63,11 @@ The concatenation is done with logical ORs." "If LEVEL is lower than `gmm-verbose' print ARGS using `message'. Guideline for numbers: -1 - error messages, 3 - non-serious error messages, 5 - messages for things -that take a long time, 7 - not very important messages on stuff, 9 - messages -inside loops." +1 - error messages +3 - non-serious error messages +5 - messages for things that take a long time +7 - not very important messages on stuff +9 - messages inside loops." (if (<= level gmm-verbose) (apply 'message args) ;; We have to do this format thingy here even if the result isn't @@ -95,11 +93,15 @@ ARGS are passed to `message'." "Non-nil if SYMBOL is a widget." (get symbol 'widget-type)) +(autoload 'widget-create-child-value "wid-edit") +(autoload 'widget-convert "wid-edit") +(autoload 'widget-default-get "wid-edit") + ;; Copy of the `nnmail-lazy' code from `nnmail.el': (define-widget 'gmm-lazy 'default - "Base widget for recursive datastructures. + "Base widget for recursive data structures. -This is copy of the `lazy' widget in Emacs 22.1 provided for compatibility." +This is a copy of the `lazy' widget in Emacs 22.1 provided for compatibility." :format "%{%t%}: %v" :convert-widget 'widget-value-convert-widget :value-create (lambda (widget) @@ -138,7 +140,7 @@ This is copy of the `lazy' widget in Emacs 22.1 provided for compatibility." ;; :mouse-2 command-on-mouse-2-press ;; :mouse-3 command-on-mouse-3-press) ;; typically a menu of related commands ;; -;; Combinations of mouse-[23] plus shift and/or controll might be overkill. +;; Combinations of mouse-[23] plus shift and/or control might be overkill. ;; ;; Then use (plist-get rs-command :none), (plist-get rs-command :shift) @@ -215,7 +217,7 @@ This is copy of the `lazy' widget in Emacs 22.1 provided for compatibility." 'static-color 'pseudo-color))))) 'gnome 'retro) - "Prefered tool bar style." + "Preferred tool bar style." :type '(choice (const :tag "GNOME style" gnome) (const :tag "Retro look" retro)) :group 'gmm) @@ -265,27 +267,16 @@ DEFAULT-MAP specifies the default key map for ICON-LIST." ;; (tool-bar-add-item ICON DEF KEY &rest PROPS) (apply 'tool-bar-add-item icon nil nil :enable nil props))) ((equal fmap t) ;; Not a menu command - (if (fboundp 'tool-bar-local-item) - (apply 'tool-bar-local-item - icon command - (intern icon) ;; reuse icon or fmap here? - tool-bar-map props) - ;; Emacs 21 compatibility: - (apply 'tool-bar-add-item - icon command - (intern icon) - props))) + (apply 'tool-bar-local-item + icon command + (intern icon) ;; reuse icon or fmap here? + tool-bar-map props)) (t ;; A menu command - (if (fboundp 'tool-bar-local-item-from-menu) - (apply 'tool-bar-local-item-from-menu - ;; (apply 'tool-bar-local-item icon def key - ;; tool-bar-map props) - command icon tool-bar-map (symbol-value fmap) - props) - ;; Emacs 21 compatibility: - (apply 'tool-bar-add-item-from-menu - command icon (symbol-value fmap) - props)))) + (apply 'tool-bar-local-item-from-menu + ;; (apply 'tool-bar-local-item icon def key + ;; tool-bar-map props) + command icon tool-bar-map (symbol-value fmap) + props))) t)) (if (symbolp icon-list) (eval icon-list) @@ -321,11 +312,11 @@ in \"`data-directory'/images\". Then this function returns a list of directories which contains first the directory in which IMAGE was found, followed by the -value of `load-path'. If PATH is given, it is used instead of +value of `load-path'. If PATH is given, it is used instead of `load-path'. If NO-ERROR is non-nil and a suitable path can't be found, don't -signal an error. Instead, return a list of directories as before, +signal an error. Instead, return a list of directories as before, except that nil appears in place of the image directory. Here is an example that uses a common idiom to provide @@ -361,8 +352,8 @@ compatibility with versions of Emacs that lack the variable dir (expand-file-name "../" dir)))) (setq image-directory-load-path dir)) - ;; If `image-directory-load-path' isn't Emacs' image directory, - ;; it's probably a user preference, so use it. Then use a + ;; If `image-directory-load-path' isn't Emacs's image directory, + ;; it's probably a user preference, so use it. Then use a ;; relative setting if possible; otherwise, use ;; `image-directory-load-path'. (cond @@ -392,7 +383,7 @@ compatibility with versions of Emacs that lack the variable ;; Set it to nil if image is not found. (cond ((file-exists-p (expand-file-name image d2ei)) d2ei) ((file-exists-p (expand-file-name image d1ei)) d1ei))))) - ;; Use Emacs' image directory. + ;; Use Emacs's image directory. (image-directory-load-path (setq image-directory image-directory-load-path)) (no-error @@ -406,7 +397,7 @@ compatibility with versions of Emacs that lack the variable (defun gmm-customize-mode (&optional mode) "Customize customization group for MODE. -If mode is nil, use `major-mode' of the curent buffer." +If mode is nil, use `major-mode' of the current buffer." (interactive) (customize-group (or mode @@ -420,16 +411,53 @@ If mode is nil, use `major-mode' of the curent buffer." In XEmacs, the seventh argument of `write-region' specifies the coding-system." - (if (and mustbenew - (or (featurep 'xemacs) - (= emacs-major-version 20))) + (if (and mustbenew (featurep 'xemacs)) (if (file-exists-p filename) - (signal 'file-already-exists - (list "File exists" filename)) + (signal 'file-already-exists (list "File exists" filename)) (write-region start end filename append visit lockname)) (write-region start end filename append visit lockname mustbenew))) +;; `interactive-p' is obsolete since Emacs 23.2. +(defmacro gmm-called-interactively-p (kind) + (condition-case nil + (progn + (eval '(called-interactively-p 'any)) + ;; Emacs >=23.2 + `(called-interactively-p ,kind)) + ;; Emacs <23.2 + (wrong-number-of-arguments '(called-interactively-p)) + ;; XEmacs + (void-function '(interactive-p)))) + +;; `flet' and `labels' are obsolete since Emacs 24.3. +(defmacro gmm-flet (bindings &rest body) + "Make temporary overriding function definitions. +This is an analogue of a dynamically scoped `let' that operates on +the function cell of FUNCs rather than their value cell. + +\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" + (require 'cl) + (if (fboundp 'cl-letf) + `(cl-letf ,(mapcar (lambda (binding) + `((symbol-function ',(car binding)) + (lambda ,@(cdr binding)))) + bindings) + ,@body) + `(flet ,bindings ,@body))) +(put 'gmm-flet 'lisp-indent-function 1) + +(defmacro gmm-labels (bindings &rest body) + "Make temporary function bindings. +The bindings can be recursive and the scoping is lexical, but capturing +them in closures will only work if `lexical-binding' is in use. But in +Emacs 24.2 and older, the lexical scoping is handled via `lexical-let' +rather than relying on `lexical-binding'. + +\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" + `(,(progn (require 'cl) (if (fboundp 'cl-labels) 'cl-labels 'labels)) + ,bindings ,@body)) +(put 'gmm-labels 'lisp-indent-function 1) + (provide 'gmm-utils) -;; arch-tag: e0b60920-2ce6-40c1-bfc0-cadbbe26b602 ;;; gmm-utils.el ends here