X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgmm-utils.el;h=dd65b809794760cc82e398949968f576647158e5;hp=b76db479dfb7091adea1f3b7464a934e035bff21;hb=2c102003004f4fa3dd5fe1f56c66936f386c4359;hpb=7271b43847a17389df540446d21657769a4f4a1b

diff --git a/lisp/gmm-utils.el b/lisp/gmm-utils.el
index b76db479d..dd65b8097 100644
--- a/lisp/gmm-utils.el
+++ b/lisp/gmm-utils.el
@@ -1,6 +1,6 @@
 ;;; gmm-utils.el --- Utility functions for Gnus, Message and MML
 
-;; Copyright (C) 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
 
 ;; Author: Reiner Steib <reiner.steib@gmx.de>
 ;; Keywords: news
@@ -99,7 +99,7 @@ ARGS are passed to `message'."
 
 ;; 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 a copy of the `lazy' widget in Emacs 22.1 provided for compatibility."
   :format "%{%t%}: %v"
@@ -140,7 +140,7 @@ This is a 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)
 
@@ -217,7 +217,7 @@ This is a 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)
@@ -328,7 +328,7 @@ compatibility with versions of Emacs that lack the variable
 
     (let* ((load-path (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\"))
            (image-load-path (cons (car load-path)
-                                  (when (boundp 'image-load-path)
+                                  (when (boundp \\='image-load-path)
                                     image-load-path))))
       (mh-tool-bar-folder-buttons-init))"
   (unless library (error "No library specified"))
@@ -352,7 +352,7 @@ 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,
+    ;; 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'.
@@ -383,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
@@ -411,15 +411,87 @@ If mode is nil, use `major-mode' of the current 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)
+(put 'gmm-flet 'edebug-form-spec '((&rest (sexp sexp &rest form)) &rest form))
+
+(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)
+(put 'gmm-labels 'edebug-form-spec '((&rest (sexp sexp &rest form)) &rest form))
+
+(defun gmm-format-time-string (format-string &optional time tz)
+  "Use FORMAT-STRING to format the time TIME, or now if omitted.
+The optional TZ specifies the time zone in a number of seconds; any
+other non-nil value will be treated as 0.  Note that both the format
+specifiers `%Z' and `%z' will be replaced with a numeric form. "
+;; FIXME: is there a smart way to replace %Z with a time zone name?
+  (if (and (numberp tz) (not (zerop tz)))
+      (let ((st 0)
+	    (case-fold-search t)
+	    ls nd rest)
+	(setq time (if time
+		       (copy-sequence time)
+		     (current-time)))
+	(if (>= (setq ls (- (cadr time) (car (current-time-zone)) (- tz))) 0)
+	    (setcar (cdr time) ls)
+	  (setcar (cdr time) (+ ls 65536))
+	  (setcar time (1- (car time))))
+	(setq tz (format "%s%02d%02d"
+			 (if (>= tz 0) "+" "-")
+			 (/ (abs tz) 3600)
+			 (/ (% (abs tz) 3600) 60)))
+	(while (string-match "%+z" format-string st)
+	  (if (zerop (% (- (setq nd (match-end 0)) (match-beginning 0)) 2))
+	      (progn
+		(push (substring format-string st (- nd 2)) rest)
+		(push tz rest))
+	    (push (substring format-string st nd) rest))
+	  (setq st nd))
+	(push (substring format-string st) rest)
+	(format-time-string (apply 'concat (nreverse rest)) time))
+    (format-time-string format-string time tz)))
+
 (provide 'gmm-utils)
 
 ;;; gmm-utils.el ends here