X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ba3189039adc8ec5eba5ed3e21d42019a4616b7c..574904bbb305c0cda4ee6bda38076f7829a9a253:/lisp/mh-e/mh-compat.el

diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el
index af9f136497..21ff5cb2cb 100644
--- a/lisp/mh-e/mh-compat.el
+++ b/lisp/mh-e/mh-compat.el
@@ -1,6 +1,6 @@
 ;;; mh-compat.el --- make MH-E compatible with various versions of Emacs
 
-;; Copyright (C) 2006-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2016 Free Software Foundation, Inc.
 
 ;; Author: Bill Wohler <wohler@newt.com>
 ;; Maintainer: Bill Wohler <wohler@newt.com>
@@ -75,11 +75,24 @@ introduced in Emacs 22."
       'cancel-timer
     'delete-itimer))
 
-;; Emacs 24 renamed flet to cl-flet.
-(defalias 'mh-cl-flet
-  (if (fboundp 'cl-flet)
-      'cl-flet
-    'flet))
+;; Emacs 24 made flet obsolete and suggested either cl-flet or
+;; cl-letf. This macro is based upon gmm-flet from Gnus.
+(defmacro mh-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...)"
+  (if (fboundp 'cl-letf)
+      `(cl-letf ,(mapcar (lambda (binding)
+                           `((symbol-function ',(car binding))
+                             (lambda ,@(cdr binding))))
+                         bindings)
+         ,@body)
+    `(flet ,bindings ,@body)))
+(put 'mh-flet 'lisp-indent-function 1)
+(put 'mh-flet 'edebug-form-spec
+     '((&rest (sexp sexp &rest form)) &rest form))
 
 (defun mh-display-color-cells (&optional display)
   "Return the number of color cells supported by DISPLAY.
@@ -96,12 +109,18 @@ expected to return an integer."
 (defmacro mh-display-completion-list (completions &optional common-substring)
   "Display the list of COMPLETIONS.
 See documentation for `display-completion-list' for a description of the
-arguments COMPLETIONS and perhaps COMMON-SUBSTRING.
-This macro is used by Emacs versions that lack a COMMON-SUBSTRING
-argument, introduced in Emacs 22."
-  (if (< emacs-major-version 22)
-      `(display-completion-list ,completions)
-    `(display-completion-list ,completions ,common-substring)))
+arguments COMPLETIONS.
+The optional argument COMMON-SUBSTRING, if non-nil, should be a string
+specifying a common substring for adding the faces
+`completions-first-difference' and `completions-common-part' to
+the completions."
+  (cond ((< emacs-major-version 22) `(display-completion-list ,completions))
+        ((fboundp 'completion-hilit-commonality) ; Emacs 23.1 and later
+         `(display-completion-list
+           (completion-hilit-commonality ,completions
+                                         ,(length common-substring) nil)))
+        (t                              ; Emacs 22
+         `(display-completion-list ,completions ,common-substring))))
 
 (defmacro mh-face-foreground (face &optional frame inherit)
   "Return the foreground color name of FACE, or nil if unspecified.
@@ -156,7 +175,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"))