Re: Future package: proposed content

Yawn!  Waking up from my long winter's nap...

Way back in late November, "Stephen J. Turnbull" <[email protected]>
wrote:
>>>>>> "viteno" == Norbert Koch <[email protected]> writes:
>
>     viteno> From my point of view this sounds like a good approach.
>     viteno> If nobody else objects to the idea, send me the file(s)
>     viteno> you already have for this package and I try to get them
>     viteno> packed up and distributed.
>
> Please don't.  It's really important that we get this either right the
> first time, or wrong in a way that doesn't screw the users no matter
> what we do to fix it.
>
> We really should think about what problems we're trying to solve, what
> APIs we want to provide, etc.  Is it really enough to have a future-x
> file?  What do we do for 21.4 when 22.0 has x-foo-new and 22.2 has a
> changed version of x-foo-new and a new function x-bar-new?  Do you
> realize that you (I mean "Norbert") may have to build separate
> versions of these things for different old versions of XEmacs (21.4
> v. 22.0)?  This has been tried before (the APEL package).  It's no
> accident that "APEL" is a 4-letter word!

Right.  However, it is also true that for what I want to do, we don't
need to solve the problem in its entirety.  I need to make sure that
propertize and replace-regexp-in-string exist, and that
pos-visible-in-window-p takes three arguments, not two.  The first two
are dumped functions (see subr.el).  The last is a core function.  This
means that there is no guessing about how to find a definition for any
of them; they are either defined already (or have the proper number of
arguments already) or not.

Here's the patch to easy-mmode.el that I've been using since I first
posted about this.  (How long ago was that?  At least 2 months, I
think.)  So how might we solve the problem of providing or patching
functions that are dumped or in core?

Index: xemacs-packages/xemacs-base/easy-mmode.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xemacs-base/easy-mmode.el,v
retrieving revision 1.3
diff -d -u -r1.3 easy-mmode.el
--- xemacs-packages/xemacs-base/easy-mmode.el	2002/09/11 20:39:13	1.3
+++ xemacs-packages/xemacs-base/easy-mmode.el	2004/01/05 17:48:42
@@ -24,7 +24,7 @@
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
-;;; Synched up with: GNU Emacs 20.7, partially with 21.2.
+;;; Synched up with: GNU Emacs 21.3.
 
 ;;; Commentary:
 
@@ -50,72 +50,124 @@
 ;; installed.  Perhaps there should be a feature to let you specify
 ;; orderings.
 
+;; Additionally to `define-minor-mode', the package provides convenient
+;; ways to define keymaps, and other helper functions for major and minor
+;; modes.
+
 ;;; Code:
 
 (eval-when-compile (require 'cl))
 
-(defmacro easy-mmode-define-toggle (mode &optional doc)
-  "Define a one arg toggle mode MODE function and associated hooks.
-MODE-mode is the so defined function that toggle the mode.
-optional DOC is its associated documentation.
+;;; This file uses three functions that did not exist or had fewer arguments
+;;; in some versions of XEmacs: propertize, replace-regexp-in-string, and
+;;; pos-visible-in-window-p.  We provide these functions here for such
+;;; XEmacsen.
+;;;
+;;; FIXME: These function definitions should go into the future package, once
+;;; that package exists.
 
-Hooks are checked for run, each time MODE-mode is called.
-They run under the followings conditions:
-MODE-hook: if the mode is toggled.
-MODE-on-hook: if the mode is on.
-MODE-off-hook: if the mode is off.
+;; XEmacs <= 21.4 does not have propertize, but XEmacs >= 21.5 dumps it (it is
+;; defined in subr.el).  Therefore, it is either defined regardless of what
+;; has been loaded already, or it won't be defined regardless of what is
+;; loaded.
+(if (not (fboundp 'propertize))
+    (defun propertize (string &rest properties)
+      "Return a copy of STRING with text properties added.
+First argument is the string to copy.
+Remaining arguments form a sequence of PROPERTY VALUE pairs for text
+properties to add to the result."
+      (let ((str (copy-sequence string)))
+	(add-text-properties 0 (length str)
+			     properties
+			     str)
+	str)))
 
-When the mode is effectively toggled, two hooks may run.
-If so MODE-hook is guaranteed to be the first.
+;; XEmacs <= 21.4 does not have replace-regexp-in-string, but XEmacs >= 21.5
+;; dumps it (it is defined in subr.el).  Therefore, it is either defined
+;; regardless of what has been loaded already, or it won't be defined
+;; regardless of what is loaded.
+(if (not (fboundp 'replace-regexp-in-string))
+    (defun replace-regexp-in-string (regexp rep string &optional
+				     fixedcase literal subexp start)
+      "Replace all matches for REGEXP with REP in STRING.
 
-\(defmacro easy-mmode-define-toggle (MODE &optional DOC)"
-  (let* ((mode-name
-	  (if (string-match "-mode\\'" (symbol-name mode))
-	      (symbol-name mode)
-	    (concat (symbol-name mode) "-mode")))
-	 (hook (intern (concat mode-name "-hook")))
-	 (hook-on (intern (concat mode-name "-on-hook")))
-	 (hook-off (intern (concat mode-name "-off-hook")))
-	 (toggle (intern mode-name))
-	 (mode toggle)
-	 (toggle-doc (or doc
-			 (format "With no argument, toggle %s mode.
-With arg turn mode on.
-With zero or negative arg turn mode off"
-				 mode-name))))
-    `(progn
-       (defvar ,hook  nil	     
-	 ,(format "Hook called when %s mode is toggled" mode-name))
+Return a new string containing the replacements.
 
-       (defvar ,hook-on  nil	     
-	 ,(format "Hook called when %s mode is turned on" mode-name))
+Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the
+arguments with the same names of function `replace-match'.  If START
+is non-nil, start replacements at that index in STRING.
 
-       (defvar ,hook-off nil
-	 ,(format "Hook called when %s mode is turned off" mode-name))
+REP is either a string used as the NEWTEXT arg of `replace-match' or a
+function.  If it is a function it is applied to each match to generate
+the replacement passed to `replace-match'; the match-data at this
+point are such that match 0 is the function's argument.
 
-       (defun ,toggle (&optional arg)
-	 ,toggle-doc
-	 (interactive "P")
-	 (let ((old-mode ,mode))
-	   (setq ,mode
-		 (if arg
-		     (or (listp arg);; C-u alone
-			 (> (prefix-numeric-value arg) 0))
-		   (not ,mode)))
-	   (and ,hook
-		(not (equal old-mode ,mode))
-	        (run-hooks ',hook))
-	   (and ,hook-on
-		,mode
-		(run-hooks ',hook-on))
-	   (and ,hook-off
-		(not ,mode)
-		(run-hooks ',hook-off)))))))
+To replace only the first match (if any), make REGEXP match up to \\'
+and replace a sub-expression, e.g.
+  (replace-regexp-in-string \"\\(foo\\).*\\'\" \"bar\" \" foo foo\" nil nil 1)
+    => \" bar foo\"
+"
+      (let ((l (length string))
+	    (start (or start 0))
+	    matches str mb me)
+	(save-match-data
+	  (while (and (< start l) (string-match regexp string start))
+	    (setq mb (match-beginning 0)
+		  me (match-end 0))
+	    ;; If we matched the empty string, make sure we advance by one char
+	    (when (= me mb) (setq me (min l (1+ mb))))
+	    ;; Generate a replacement for the matched substring.
+	    ;; Operate only on the substring to minimize string consing.
+	    ;; Set up match data for the substring for replacement;
+	    ;; presumably this is likely to be faster than munging the
+	    ;; match data directly in Lisp.
+	    (string-match regexp (setq str (substring string mb me)))
+	    (setq matches
+		  (cons (replace-match (if (stringp rep)
+					   rep
+					 (funcall rep (match-string 0 str)))
+				       fixedcase literal str subexp)
+			(cons (substring string start mb) ; unmatched prefix
+			      matches)))
+	    (setq start me))
+	  ;; Reconstruct a string from the pieces.
+	  (setq matches (cons (substring string start l) matches)) ; leftover
+	  (apply #'concat (nreverse matches))))))
 
+;; XEmacs < 2.5.16 has a version of pos-visible-in-window-p that takes only 2
+;; arguments.  The third argument, PARTIALLY, can be ignored safely, with the
+;; caveat that there may some visible glitches on a partially visible last
+;; line.
+(when (eq (function-max-args #'pos-visible-in-window-p) 2)
+  (fset 'pos-visible-in-window-p
+	`(lambda (&optional pos window partially)
+	   "Returns t if position POS is currently on the frame in WINDOW.
+Returns nil if that position is scrolled vertically out of view.
+If a character is only partially visible, nil is returned, unless the
+optional argument PARTIALLY is non-nil.
+POS defaults to point in WINDOW's buffer; WINDOW, to the selected window."
+	   (funcall ,(symbol-function 'pos-visible-in-window-p) pos window))))
+
+
+(defun easy-mmode-pretty-mode-name (mode &optional lighter)
+  "Turn the symbol MODE into a string intended for the user.
+If provided LIGHTER will be used to help choose capitalization."
+  (let* ((case-fold-search t)
+	 (name (concat (replace-regexp-in-string
+			"-Minor" " minor"
+			(capitalize (replace-regexp-in-string
+				     "-mode\\'" "" (symbol-name mode))))
+		       " mode")))
+    (if (not (stringp lighter)) name
+      (setq lighter
+	    (replace-regexp-in-string "\\`\\s-+\\|\\-s+\\'" "" lighter))
+      (replace-regexp-in-string lighter lighter name t t))))
+
+;; XEmacs change: add -on-hook, -off-hook, and macro parameter documentation.
 ;;;###autoload
 (defalias 'easy-mmode-define-minor-mode 'define-minor-mode)
 ;;;###autoload
-(defmacro define-minor-mode (mode doc &optional init-value lighter keymap)
+(defmacro define-minor-mode (mode doc &optional init-value lighter keymap &rest body)
   "Define a new minor mode MODE.
 This function defines the associated control variable MODE, keymap MODE-map,
 toggle command MODE, and hook MODE-hook.
@@ -127,34 +179,248 @@
   If it is a list, it is passed to `easy-mmode-define-keymap'
   in order to build a valid keymap.  It's generally better to use
   a separate MODE-map variable than to use this argument.
+The above three arguments can be skipped if keyword arguments are
+used (see below).
+
+BODY contains code that will be executed each time the mode is (de)activated.
+  It will be executed after any toggling but before running the hooks.
+  BODY can start with a list of CL-style keys specifying additional arguments.
+  The following keyword arguments are supported:
+:group   Followed by the group name to use for any generated `defcustom'.
+:global  If non-nil specifies that the minor mode is not meant to be
+         buffer-local.  By default, the variable is made buffer-local.
+:init-value  Same as the INIT-VALUE argument.
+:lighter  Same as the LIGHTER argument.
+
+For backwards compatibility, these hooks are run each time the mode is
+(de)activated.  When the mode is toggled, MODE-hook is always run before the
+other hook.
+MODE-hook: run if the mode is toggled.
+MODE-on-hook: run if the mode is activated.
+MODE-off-hook: run if the mode is deactivated.
  
 \(defmacro easy-mmode-define-minor-mode
-  (MODE DOC &optional INIT-VALUE LIGHTER KEYMAP)...\)" 
+  (MODE DOC &optional INIT-VALUE LIGHTER KEYMAP &rest BODY)...\)" 
+  ;; Allow skipping the first three args.
+  (cond
+   ((keywordp init-value)
+    (setq body (list* init-value lighter keymap body)
+	  init-value nil lighter nil keymap nil))
+   ((keywordp lighter)
+    (setq body (list* lighter keymap body) lighter nil keymap nil))
+   ((keywordp keymap) (push keymap body) (setq keymap nil)))
+
   (let* ((mode-name (symbol-name mode))
-	 (mode-doc (format "Non-nil if %s mode is enabled." mode-name))
-	 (keymap-name (concat mode-name "-map"))
-	 (keymap-doc (format "Keymap for %s mode." mode-name)))
+	 (pretty-name (easy-mmode-pretty-mode-name mode lighter))
+	 (globalp nil)
+	 (togglep t)			;why would you ever prevent toggling?
+	 (group nil)
+	 (extra-args nil)
+	 (keymap-sym (if (and keymap (symbolp keymap)) keymap
+		       (intern (concat mode-name "-map"))))
+	 (hook (intern (concat mode-name "-hook")))
+	 (hook-on (intern (concat mode-name "-on-hook")))
+	 (hook-off (intern (concat mode-name "-off-hook"))))
+
+    ;; Check keys.
+    (while (keywordp (car body))
+      (case (pop body)
+	(:init-value (setq init-value (pop body)))
+	(:lighter (setq lighter (pop body)))
+	(:global (setq globalp (pop body)))
+	(:extra-args (setq extra-args (pop body)))
+	(:group (setq group (nconc group (list :group (pop body)))))
+	(t (pop body))))
+
+    (unless group
+      ;; We might as well provide a best-guess default group.
+      (setq group
+	    `(:group ',(intern (replace-regexp-in-string "-mode\\'" ""
+							 mode-name)))))
+    ;; Add default properties to LIGHTER.
+    (unless (or (not (stringp lighter))
+		(get-text-property 0 'local-map lighter)
+		(get-text-property 0 'keymap lighter))
+      (setq lighter
+	    (propertize lighter
+			'local-map modeline-minor-mode-map ; XEmacs change
+			'help-echo "mouse-3: minor mode menu")))
+
     `(progn
-       ;; define the switch
-       (defvar ,mode ,init-value ,mode-doc)
-       (make-variable-buffer-local ',mode)
+       ;; Define the variable to enable or disable the mode.
+       ,(if (not globalp)
+	    `(progn
+	       (defvar ,mode ,init-value ,(format "Non-nil if %s is enabled.
+Use the command `%s' to change this variable." pretty-name mode))
+	       (make-variable-buffer-local ',mode))
 
-       ;; define the minor-mode keymap
-       (defvar ,(intern keymap-name)
-	 (cond ((and ,keymap (keymapp ,keymap))
-		,keymap)
-	       ((listp ,keymap)
-		(easy-mmode-define-keymap ,keymap))
-	       (t (error "Invalid keymap %S" ,keymap)))
-	 ,keymap-doc)
+	  (let ((curfile (or (and (boundp 'byte-compile-current-file)
+				  byte-compile-current-file)
+			     load-file-name)))
+	    `(defcustom ,mode ,init-value
+	       ,(format "Non-nil if %s is enabled.
+See the command `%s' for a description of this minor-mode.
+Setting this variable directly does not take effect;
+use either \\[customize] or the function `%s'."
+			pretty-name mode mode)
+	       :set (lambda (symbol value) (funcall symbol (or value 0)))
+	       :initialize 'custom-initialize-default
+	       ,@group
+	       :type 'boolean
+	       ,@(when curfile
+		   (list
+		    :require
+		    (list 'quote
+			  (intern (file-name-nondirectory
+				   (file-name-sans-extension curfile)))))))))
 
-       ;; define the toggle and the hooks
-       ,(macroexpand `(easy-mmode-define-toggle ,mode ,doc)) ; toggle and hooks
+       ;; The actual function.
+       (defun ,mode (&optional arg ,@extra-args)
+	 ,(or doc
+	      (format (concat "Toggle %s on or off.
+Interactively, with no prefix argument, toggle the mode.
+With universal prefix ARG " (unless togglep "(or if ARG is nil) ") "turn mode on.
+With zero or negative ARG turn mode off.
+\\{%s}") pretty-name keymap-sym))
+	 ;; Make no arg by default in an interactive call,
+	 ;; so that repeating the command toggles again.
+	 ;; XEmacs change: use the "P" arg.
+	 (interactive "P")
+	 ;; XEmacs addition: save the old mode
+	 (let ((old-mode ,mode))
+	   (setq ,mode
+		 (if arg
+		     (or (listp arg);; XEmacs addition: C-u alone
+			 (> (prefix-numeric-value arg) 0))
+		   ,(if togglep `(not ,mode) t)))
+	   ,@body
+	   ;; The on/off hooks are here for backward compatibility only.
+	   ;; XEmacs change: check mode before running hooks
+	   (and ,hook
+		(not (equal old-mode ,mode))
+		(run-hooks ',hook))
+	   (and ,hook-on
+		,mode
+		(run-hooks ',hook-on))
+	   (and ,hook-off
+		(not ,mode)
+		(run-hooks ',hook-off)))
+	 ;; Return the new setting.
+	 (if (interactive-p)
+	     (message ,(format "%s %%sabled" pretty-name)
+		      (if ,mode "en" "dis")))
+	 (force-mode-line-update)
+	 ,mode)
 
-       ;; XEmacs change: use the API to add the keymap to minor-mode-alist
-       ;; and add the modeline indicator.
-       (add-minor-mode ',mode ,lighter ,(intern keymap-name) t ',mode))))
+       ;; FIXME: XEmacs does not support :autoload-end
+       ;; Autoloading an easy-mmode-define-minor-mode autoloads
+       ;; everything up-to-here.
+:autoload-end
+
+       ;; The toggle's hook.
+       (defcustom ,hook nil
+	 ,(format "Hook run at the end of function `%s'." mode-name)
+	 :group ,(cadr group)
+	 :type 'hook)
 
+       ;; Define the minor-mode keymap.
+       ,(unless (symbolp keymap)	;nil is also a symbol.
+	  `(defvar ,keymap-sym
+	     (let ((m ,keymap))
+	       (cond ((keymapp m) m)
+		     ((listp m) (easy-mmode-define-keymap m))
+		     (t (error "Invalid keymap %S" ,keymap))))
+	     ,(format "Keymap for `%s'." mode-name)))
+
+       (add-minor-mode ',mode ',lighter
+		       ,(if keymap keymap-sym
+			  `(if (boundp ',keymap-sym)
+			       (symbol-value ',keymap-sym)))
+		       ;; XEmacs change: supply the AFTER and TOGGLE-FUN args
+		       t ',mode)
+
+       ;; If the mode is global, call the function according to the default.
+       ,(if globalp
+	    `(if (and load-file-name ,mode
+		      (not purify-flag))
+		 (eval-after-load load-file-name '(,mode 1)))))))
+
+;;;
+;;; make global minor mode
+;;;
+
+;;;###autoload
+(defmacro easy-mmode-define-global-mode (global-mode mode turn-on
+						     &rest keys)
+  "Make GLOBAL-MODE out of the buffer-local minor MODE.
+TURN-ON is a function that will be called with no args in every buffer
+  and that should try to turn MODE on if applicable for that buffer.
+KEYS is a list of CL-style keyword arguments:
+:group to specify the custom group."
+  (let* ((global-mode-name (symbol-name global-mode))
+	 (pretty-name (easy-mmode-pretty-mode-name mode))
+	 (pretty-global-name (easy-mmode-pretty-mode-name global-mode))
+	 (group nil)
+	 (extra-args nil)
+	 (buffers (intern (concat global-mode-name "-buffers")))
+	 (cmmh (intern (concat global-mode-name "-cmmh"))))
+
+    ;; Check keys.
+    (while (keywordp (car keys))
+      (case (pop keys)
+	(:extra-args (setq extra-args (pop keys)))
+	(:group (setq group (nconc group (list :group (pop keys)))))
+	(t (setq keys (cdr keys)))))
+
+    (unless group
+      ;; We might as well provide a best-guess default group.
+      (setq group
+	    `(:group ',(intern (replace-regexp-in-string "-mode\\'" ""
+							 (symbol-name mode))))))
+    `(progn
+       ;; The actual global minor-mode
+       (define-minor-mode ,global-mode
+	 ,(format "Toggle %s in every buffer.
+With prefix ARG, turn %s on if and only if ARG is positive.
+%s is actually not turned on in every buffer but only in those
+in which `%s' turns it on."
+		  pretty-name pretty-global-name pretty-name turn-on)
+	 :global t :extra-args ,extra-args ,@group
+
+	 ;; Setup hook to handle future mode changes and new buffers.
+	 (if ,global-mode
+	     (progn
+	       (add-hook 'find-file-hooks ',buffers)
+	       (add-hook 'change-major-mode-hook ',cmmh))
+	   (remove-hook 'find-file-hooks ',buffers)
+	   (remove-hook 'change-major-mode-hook ',cmmh))
+
+	 ;; Go through existing buffers.
+	 (dolist (buf (buffer-list))
+	   (with-current-buffer buf
+	     (if ,global-mode (,turn-on) (when ,mode (,mode -1))))))
+
+       ;; FIXME: XEmacs does not support :autoload-end
+       ;; Autoloading easy-mmode-define-global-mode
+       ;; autoloads everything up-to-here.
+:autoload-end
+
+       ;; List of buffers left to process.
+       (defvar ,buffers nil)
+
+       ;; The function that calls TURN-ON in each buffer.
+       (defun ,buffers ()
+	 (remove-hook 'post-command-hook ',buffers)
+	 (while ,buffers
+	   (let ((buf (pop ,buffers)))
+	     (when (buffer-live-p buf)
+	       (with-current-buffer buf (,turn-on))))))
+
+       ;; The function that catches kill-all-local-variables.
+       (defun ,cmmh ()
+	 (add-to-list ',buffers (current-buffer))
+	 (add-hook 'post-command-hook ',buffers)))))
+
 ;;;
 ;;; easy-mmode-defmap
 ;;;
@@ -218,6 +484,33 @@
 
 
 ;;;
+;;; easy-mmode-defsyntax
+;;;
+
+(defun easy-mmode-define-syntax (css args)
+  (let ((st (make-syntax-table (plist-get args :copy)))
+	(parent (plist-get args :inherit)))
+    (dolist (cs css)
+      (let ((char (car cs))
+	    (syntax (cdr cs)))
+	(if (sequencep char)
+	    (mapcar (lambda (c) (modify-syntax-entry c syntax st)) char)
+	  (modify-syntax-entry char syntax st))))
+    (if parent (set-char-table-parent
+		st (if (symbolp parent) (symbol-value parent) parent)))
+    st))
+
+;;;###autoload
+(defmacro easy-mmode-defsyntax (st css doc &rest args)
+  "Define variable ST as a syntax-table.
+CSS contains a list of syntax specifications of the form (CHAR . SYNTAX)."
+  `(progn
+     (autoload 'easy-mmode-define-syntax "easy-mmode")
+     (defconst ,st (easy-mmode-define-syntax ,css ,(cons 'list args)) ,doc)))
+
+
+
+;;;
 ;;; easy-mmode-define-navigation
 ;;;
 
@@ -256,8 +549,7 @@
 				  ,(if endfun `(,endfun)
 				     `(re-search-forward ,re nil t 2)))
 				(point-max))))
-		 ;; XEmacs change: only 2 args to pos-visible-in-window-p
-		 (unless (pos-visible-in-window-p endpt nil)
+		 (unless (pos-visible-in-window-p endpt nil t)
 		   (recenter '(0))))))))
        (defun ,prev-sym (&optional count)
 	 ,(format "Go to the previous COUNT'th %s" (or name base-name))

-- 
Jerry James
http://www.ittc.ku.edu/~james/