xemacs

Gbp-Pq: Name 01-xemacs

2 files changed, 429 insertions, 3 deletions

diff --git a/cl-lib.el b/cl-lib.el
new file mode 100644
index 0000000..ec330d7
--- /dev/null
+++ b/cl-lib.el
@@ -0,0 +1,424 @@
+;;; cl-lib.el --- Properly prefixed CL functions and macros  -*- coding: utf-8 -*-
+
+;; Copyright (C) 2012, 2013, 2014, 2017  Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+;; vcomment: Emacs-24.3's version is 1.0 so this has to stay below.
+;; Version: 0.6.1
+;; Y-Package-Requires: ((emacs "21")) ¡`emacs' package only exists in Emacs≥24!
+
+;; This program 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 of the License, or
+;; (at your option) any later version.
+
+;; This program 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
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This is a forward compatibility package, which provides (a subset of) the
+;; features of the cl-lib package introduced in Emacs-24.3, for use on
+;; previous emacsen (it should work on Emacs≥21 as well as XEmacs).
+
+;; Make sure this is installed *late* in your `load-path`, i.e. after Emacs's
+;; built-in .../lisp/emacs-lisp directory, so that if/when you upgrade to
+;; Emacs-24.3, the built-in version of the file will take precedence, otherwise
+;; you could get into trouble (although we try to hack our way around the
+;; problem in case it happens).
+
+;; This code is largely copied from Emacs-24.3's cl.el, with the alias bindings
+;; simply reversed.
+
+;;; Code:
+
+;; We need to handle the situation where this package is used with an Emacs
+;; that comes with a real cl-lib (i.e. ≥24.3).
+
+;; First line of defense: try to make sure the built-in cl-lib comes earlier in
+;; load-path so we never get loaded:
+;;;###autoload (let ((d (file-name-directory #$)))
+;;;###autoload   (when (member d load-path)
+;;;###autoload     (setq load-path (append (remove d load-path) (list d)))))
+
+(when (functionp 'macroexp--compiler-macro)
+  ;; `macroexp--compiler-macro' was introduced as part of the big CL
+  ;; reorganization which moved/reimplemented some of CL into core (mostly the
+  ;; setf and compiler-macro support), so its presence indicates we're running
+  ;; in an Emacs that comes with the new cl-lib.el, where this file should
+  ;; never be loaded!
+  (message "Real cl-lib shadowed by compatibility cl-lib? (%s)" load-file-name)
+  (when load-file-name
+    ;; (message "Let's try to patch things up")
+    (let ((loaddir (file-name-directory load-file-name))
+          load-path-dir)
+      ;; Find the problematic directory from load-path.
+      (dolist (dir load-path)
+        (if (equal loaddir (expand-file-name (file-name-as-directory dir)))
+            (setq load-path-dir dir)))
+      (when load-path-dir
+        ;; (message "Let's move the offending dir to the end")
+        (setq load-path (append (remove load-path-dir load-path)
+                                (list load-path-dir)))
+        ;; Here we could manually load cl-lib and then return immediately.
+        ;; But Emacs currently doesn't provide any way for a file to "return
+        ;; immediately", so instead we make sure the rest of the file does not
+        ;; throw away any pre-existing definition.
+        ))))
+
+(require 'cl)
+
+;; Some of Emacs-24.3's cl.el definition are not just aliases, because either
+;; the feature was dropped from cl-lib.el or because the cl-lib version is
+;; not fully compatible.
+;; Let's just not include them here, since it is very important that if code
+;; works with this cl-lib.el it should also work with Emacs-24.3's cl-lib.el,
+;; whereas the reverse is much less important.
+
+(dolist (var '(
+               ;; loop-result-var
+               ;; loop-result
+               ;; loop-initially
+               ;; loop-finally
+               ;; loop-bindings
+               ;; loop-args
+               ;; bind-inits
+               ;; bind-block
+               ;; lambda-list-keywords
+               float-negative-epsilon
+               float-epsilon
+               least-negative-normalized-float
+               least-positive-normalized-float
+               least-negative-float
+               least-positive-float
+               most-negative-float
+               most-positive-float
+               ;; custom-print-functions
+               ))
+  (let ((new (intern (format "cl-%s" var))))
+    (if (fboundp 'defvaralias)
+        (unless (boundp new) (defvaralias new var))
+      (if (fboundp 'cl-float-limits) (cl-float-limits))
+      (eval `(defvar ,new ,var ,(format "`cl-lib' alias of `%s'" var))))))
+
+;; The following cl-lib functions were already defined in the old cl.el,
+;; with a different meaning:
+;; - cl-position and cl-delete-duplicates
+;;   the two meanings are clearly different, but we can distinguish which was
+;;   meant by looking at the arguments.
+;; - cl-member
+;;   the old meaning hasn't been used for a long time and is a subset of the
+;;   new, so we can simply override it.
+;; - cl-adjoin
+;;   the old meaning is actually the same as the new except for optimizations.
+
+(dolist (fun '(
+               (get* . cl-get)
+               (random* . cl-random)
+               (rem* . cl-rem)
+               (mod* . cl-mod)
+               (round* . cl-round)
+               (truncate* . cl-truncate)
+               (ceiling* . cl-ceiling)
+               (floor* . cl-floor)
+               (rassoc* . cl-rassoc)
+               (assoc* . cl-assoc)
+               ;; (member* . cl-member) ;Handle specially below.
+               (delete* . cl-delete)
+               (remove* . cl-remove)
+               (defsubst* . cl-defsubst)
+               (sort* . cl-sort)
+               (function* . cl-function)
+               (defmacro* . cl-defmacro)
+               (defun* . cl-defun)
+               (mapcar* . cl-mapcar)
+
+               remprop
+               getf
+               tailp
+               list-length
+               nreconc
+               revappend
+               concatenate
+               subseq
+               random-state-p
+               make-random-state
+               signum
+               isqrt
+               lcm
+               gcd
+               notevery
+               notany
+               every
+               some
+               mapcon
+               mapcan
+               mapl
+               maplist
+               map
+               equalp
+               coerce
+               tree-equal
+               nsublis
+               sublis
+               nsubst-if-not
+               nsubst-if
+               nsubst
+               subst-if-not
+               subst-if
+               subsetp
+               nset-exclusive-or
+               set-exclusive-or
+               nset-difference
+               set-difference
+               nintersection
+               intersection
+               nunion
+               union
+               rassoc-if-not
+               rassoc-if
+               assoc-if-not
+               assoc-if
+               member-if-not
+               member-if
+               merge
+               stable-sort
+               search
+               mismatch
+               count-if-not
+               count-if
+               count
+               position-if-not
+               position-if
+               ;; position ;Handle specially via defadvice below.
+               find-if-not
+               find-if
+               find
+               nsubstitute-if-not
+               nsubstitute-if
+               nsubstitute
+               substitute-if-not
+               substitute-if
+               substitute
+               ;; delete-duplicates ;Handle specially via defadvice below.
+               remove-duplicates
+               delete-if-not
+               delete-if
+               remove-if-not
+               remove-if
+               replace
+               fill
+               reduce
+               compiler-macroexpand
+               define-compiler-macro
+               assert
+               check-type
+               typep
+               deftype
+               defstruct
+               callf2
+               callf
+               letf*
+               letf
+               rotatef
+               shiftf
+               remf
+               psetf
+               declare
+               the
+               locally
+               multiple-value-setq
+               multiple-value-bind
+               symbol-macrolet
+               macrolet
+               progv
+               psetq
+               do-all-symbols
+               do-symbols
+               dotimes
+               dolist
+               do*
+               do
+               loop
+               return-from
+               return
+               block
+               etypecase
+               typecase
+               ecase
+               case
+               load-time-value
+               eval-when
+               destructuring-bind
+               gentemp
+               gensym
+               pairlis
+               acons
+               subst
+               ;; adjoin ;It's already defined.
+               copy-list
+               ldiff
+               list*
+               cddddr
+               cdddar
+               cddadr
+               cddaar
+               cdaddr
+               cdadar
+               cdaadr
+               cdaaar
+               cadddr
+               caddar
+               cadadr
+               cadaar
+               caaddr
+               caadar
+               caaadr
+               caaaar
+               cdddr
+               cddar
+               cdadr
+               cdaar
+               caddr
+               cadar
+               caadr
+               caaar
+               tenth
+               ninth
+               eighth
+               seventh
+               sixth
+               fifth
+               fourth
+               third
+               endp
+               rest
+               second
+               first
+               svref
+               copy-seq
+               evenp
+               oddp
+               minusp
+               plusp
+               floatp-safe
+               declaim
+               proclaim
+               nth-value
+               multiple-value-call
+               multiple-value-apply
+               multiple-value-list
+               values-list
+               values
+               pushnew
+               decf
+               incf
+
+               dolist
+               dotimes
+               ))
+  (let ((new (if (consp fun) (prog1 (cdr fun) (setq fun (car fun)))
+               (intern (format "cl-%s" fun)))))
+    (if (fboundp new)
+        (unless (or (eq (symbol-function new) fun)
+                    (eq new (and (symbolp fun) (fboundp fun)
+                                 (symbol-function fun))))
+          (message "%S already defined, not rebinding" new))
+      (defalias new fun))))
+
+(unless (symbolp (symbol-function 'position))
+  (autoload 'cl-position "cl-seq")
+  (defadvice cl-position (around cl-lib (cl-item cl-seq &rest cl-keys) activate)
+  (let ((argk (ad-get-args 2)))
+    (if (or (null argk) (keywordp (car argk)))
+        ;; This is a call to cl-lib's `cl-position'.
+        (setq ad-return-value
+              (apply #'position (ad-get-arg 0) (ad-get-arg 1) argk))
+      ;; Must be a call to cl's old `cl-position'.
+      ad-do-it))))
+
+(unless (symbolp (symbol-function 'delete-duplicates))
+  (autoload 'cl-delete-duplicates "cl-seq")
+  (defadvice cl-delete-duplicates (around cl-lib (cl-seq &rest cl-keys) activate)
+  (let ((argk (ad-get-args 1)))
+    (if (or (null argk) (keywordp (car argk)))
+        ;; This is a call to cl-lib's `cl-delete-duplicates'.
+        (setq ad-return-value
+              (apply #'delete-duplicates (ad-get-arg 0) argk))
+      ;; Must be a call to cl's old `cl-delete-duplicates'.
+      ad-do-it))))
+
+(when (or (not (fboundp 'cl-member))
+          (eq (symbol-function 'cl-member) #'memq))
+  (defalias 'cl-member #'member*))
+
+;; `cl-labels' is not 100% compatible with `labels' when using dynamic scoping
+;; (mostly because it does not turn lambdas that refer to those functions into
+;; closures).  OTOH it is compatible when using lexical scoping.
+
+(unless (fboundp 'cl-labels)
+  (defmacro cl-labels (&rest args)
+    (unless (and (boundp 'lexical-binding) lexical-binding)
+      ;; We used to signal an error rather than a message, but in many uses of
+      ;; cl-labels, the value of lexical-binding doesn't actually matter.
+      ;; More importantly, the value of `lexical-binding' here is unreliable
+      ;; (it does not necessarily reflect faithfully whether the output of this
+      ;; macro will be interpreted as lexically bound code or not).
+      (message "This `cl-labels' requires `lexical-binding' to be non-nil"))
+    `(labels ,@args)))
+
+;;;; ChangeLog:
+
+;; 2017-01-06  Stefan Monnier  <monnier@iro.umontreal.ca>
+;; 
+;; 	* cl-lib/cl-lib.el: Don't use `emacs` package for Emacs<24
+;; 
+;; 2017-01-04  Stefan Monnier  <monnier@iro.umontreal.ca>
+;; 
+;; 	* cl-lib/cl-lib.el: Make it work for Emacs-21.	Bump version to 0.6
+;; 
+;; 	(var aliases): Don't assume `defvaralias' is available.
+;; 
+;; 2014-02-25  Stefan Monnier  <monnier@iro.umontreal.ca>
+;; 
+;; 	Fixes: debbugs:16671
+;; 
+;; 	* cl-lib.el (cl-position, cl-delete-duplicate): Don't advise if >=24.3.
+;; 	(load-path): Try to make sure we're at the end.
+;; 
+;; 2014-01-25  Stefan Monnier  <monnier@iro.umontreal.ca>
+;; 
+;; 	* cl-lib.el: Resolve conflicts with old internal definitions
+;; 	(bug#16353).
+;; 	(dolist fun): Don't skip definitions silently.
+;; 	(define-setf-expander): Remove, not in cl-lib.
+;; 	(cl-position, cl-delete-duplicates): Add advice to distinguish the use
+;; 	case.
+;; 	(cl-member): Override old definition.
+;; 
+;; 2013-05-22  Stefan Monnier  <monnier@iro.umontreal.ca>
+;; 
+;; 	* cl-lib.el (cl-labels): Demote error to message and improve it.
+;; 
+;; 2012-11-30  Stefan Monnier  <monnier@iro.umontreal.ca>
+;; 
+;; 	* cl-lib.el: Try and patch things up in case we're hiding the real
+;; 	cl-lib.
+;; 
+;; 2012-11-22  Stefan Monnier  <monnier@iro.umontreal.ca>
+;; 
+;; 	Add cl-letf and cl-labels.
+;; 
+;; 2012-11-16  Stefan Monnier  <monnier@iro.umontreal.ca>
+;; 
+;; 	* packages/cl-lib: New package.
+;; 
+
+
+(provide 'cl-lib)
+;;; cl-lib.el ends here
diff --git a/mmm-vars.el b/mmm-vars.el
index b567bb0..f24ff16 100644
--- a/mmm-vars.el
+++ b/mmm-vars.el
@@ -49,9 +49,11 @@
 (defvar mmm-primary-mode)
 (defvar mmm-classes-alist)
 (defvar mmm-current-overlay)
-(declare-function mmm-apply-all "mmm-class")
-(declare-function mmm-set-class-parameter "mmm-class" (class param value))
-(declare-function mmm-get-class-parameter "mmm-class" (class param))
+(when (not mmm-xemacs)
+	(declare-function mmm-apply-all "mmm-class")
+	(declare-function mmm-set-class-parameter "mmm-class" (class param value))
+	(declare-function mmm-get-class-parameter "mmm-class" (class param))
+	)
 
 ;;}}}
 ;;{{{ Error Conditions