gmm-utils.el (gmm-called-interactively-p): Restore as a macro.
[gnus] / lisp / gmm-utils.el
index 84b69ed..ef60713 100644 (file)
@@ -1,39 +1,35 @@
 ;;; gmm-utils.el --- Utility functions for Gnus, Message and MML
 
-;; Copyright (C) 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
 
 ;; Author: Reiner Steib <reiner.steib@gmx.de>
 ;; 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
-;; 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 <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
 ;; This library provides self-contained utility functions.  The functions are
 ;; used in Gnus, Message and MML, but within this library there are no
-;; dependencies on Gnus, Message, or MML or Gnus.
+;; dependencies on Gnus, Message, or MML.
 
 ;;; 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)
 (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
   :group 'gmm)
 
+;;;###autoload
+(defun gmm-regexp-concat (regexp)
+  "Potentially concat a list of regexps into a single one.
+The concatenation is done with logical ORs."
+  (cond ((null regexp)
+        nil)
+       ((stringp regexp)
+        regexp)
+       ((listp regexp)
+        (mapconcat (lambda (elt) (concat "\\(" elt "\\)"))
+                   regexp
+                   "\\|"))))
+
 ;;;###autoload
 (defun gmm-message (level &rest args)
   "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
@@ -79,14 +90,18 @@ ARGS are passed to `message'."
 
 ;;;###autoload
 (defun gmm-widget-p (symbol)
-  "Non-nil iff SYMBOL is a widget."
+  "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.
 
-This is copy of the `lazy' widget in Emacs 22.1 provided for compatibility."
+This is 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)
@@ -125,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)
 
@@ -202,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)
@@ -217,7 +232,7 @@ Within each entry of ICON-LIST, the first element is a menu
 command, the second element is an icon file name and the third
 element is a test function.  You can use \\[describe-key]
 <menu-entry> to find out the name of a menu command.  The fourth
-and all following elements are passed a the PROPS argument to the
+and all following elements are passed as the PROPS argument to the
 function `tool-bar-local-item'.
 
 If ZAP-LIST is a list, remove those item from the default
@@ -252,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)
@@ -308,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
@@ -348,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
@@ -379,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
@@ -393,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
@@ -407,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