X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Fsubr.el;h=593703026fa43f7d99ddef927811abc81029d05b;hp=54cf7f15282559bf19b0bd97754596e9a6561281;hb=eeca41d3213b7a3b7efcf6508693e748c1590748;hpb=dbf2768f7b146e97e37a27316f70bb313f1acf15

diff --git a/lisp/subr.el b/lisp/subr.el
index 54cf7f1..5937030 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -25,7 +25,7 @@
 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 ;; 02111-1307, USA.
 
-;;; Synched up with: FSF 19.34.
+;;; Synched up with: FSF 19.34.  Some things synched up with later versions.
 
 ;;; Commentary:
 
@@ -403,22 +403,70 @@ Otherwise treat `\\' in NEWTEXT as special:
 	    str newstr))
     str)))
 
-(defun split-string (string &optional pattern)
-  "Return a list of substrings of STRING which are separated by PATTERN.
-If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
-  (or pattern
-      (setq pattern "[ \f\t\n\r\v]+"))
-  (let (parts (start 0) (len (length string)))
-    (if (string-match pattern string)
-	(setq parts (cons (substring string 0 (match-beginning 0)) parts)
-	      start (match-end 0)))
-    (while (and (< start len)
-		(string-match pattern string (if (> start (match-beginning 0))
-						 start
-					       (1+ start))))
-      (setq parts (cons (substring string start (match-beginning 0)) parts)
-	    start (match-end 0)))
-    (nreverse (cons (substring string start) parts))))
+(defconst split-string-default-separators "[ \f\t\n\r\v]+"
+  "The default value of separators for `split-string'.
+
+A regexp matching strings of whitespace.  May be locale-dependent
+\(as yet unimplemented).  Should not match non-breaking spaces.
+
+Warning: binding this to a different value and using it as default is
+likely to have undesired semantics.")
+
+;; specification for `split-string' agreed with rms 2003-04-23
+;; xemacs design <87vfx5vor0.fsf@tleepslib.sk.tsukuba.ac.jp>
+
+;; The specification says that if both SEPARATORS and OMIT-NULLS are
+;; defaulted, OMIT-NULLS should be treated as t.  Simplifying the logical
+;; expression leads to the equivalent implementation that if SEPARATORS
+;; is defaulted, OMIT-NULLS is treated as t.
+
+(defun split-string (string &optional separators omit-nulls)
+  "Splits STRING into substrings bounded by matches for SEPARATORS.
+
+The beginning and end of STRING, and each match for SEPARATORS, are
+splitting points.  The substrings matching SEPARATORS are removed, and
+the substrings between the splitting points are collected as a list,
+which is returned.
+
+If SEPARATORS is non-nil, it should be a regular expression matching text
+which separates, but is not part of, the substrings.  If nil it defaults to
+`split-string-default-separators', normally \"[ \\f\\t\\n\\r\\v]+\", and
+OMIT-NULLS is forced to t.
+
+If OMIT-NULLS is t, zero-length substrings are omitted from the list \(so
+that for the default value of SEPARATORS leading and trailing whitespace
+are effectively trimmed).  If nil, all zero-length substrings are retained,
+which correctly parses CSV format, for example.
+
+Note that the effect of `(split-string STRING)' is the same as
+`(split-string STRING split-string-default-separators t)').  In the rare
+case that you wish to retain zero-length substrings when splitting on
+whitespace, use `(split-string STRING split-string-default-separators nil)'.
+
+Modifies the match data when successful; use `save-match-data' if necessary."
+
+  (let ((keep-nulls (not (if separators omit-nulls t)))
+	(rexp (or separators split-string-default-separators))
+	(start 0)
+	notfirst
+	(list nil))
+    (while (and (string-match rexp string
+			      (if (and notfirst
+				       (= start (match-beginning 0))
+				       (< start (length string)))
+				  (1+ start) start))
+		(< start (length string)))
+      (setq notfirst t)
+      (if (or keep-nulls (< start (match-beginning 0)))
+	  (setq list
+		(cons (substring string start (match-beginning 0))
+		      list)))
+      (setq start (match-end 0)))
+    (if (or keep-nulls (< start (length string)))
+	(setq list
+	      (cons (substring string start)
+		    list)))
+    (nreverse list)))
 
 ;; #### #### #### AAaargh!  Must be in C, because it is used insanely
 ;; early in the bootstrap process.
@@ -487,6 +535,43 @@ See also `with-temp-file' and `with-output-to-string'."
 	 (and (buffer-name ,temp-buffer)
 	      (kill-buffer ,temp-buffer))))))
 
+;; BEGIN FSF 21.3 SYNCH
+(defmacro with-local-quit (&rest body)
+  "Execute BODY with `inhibit-quit' temporarily bound to nil."
+  `(condition-case nil
+    (let ((inhibit-quit nil))
+      ,@body)
+    (quit (setq quit-flag t))))
+
+(defvar delay-mode-hooks nil
+  "If non-nil, `run-mode-hooks' should delay running the hooks.")
+(defvar delayed-mode-hooks nil
+  "List of delayed mode hooks waiting to be run.")
+(make-variable-buffer-local 'delayed-mode-hooks)
+(put 'delay-mode-hooks 'permanent-local t)
+
+(defun run-mode-hooks (&rest hooks)
+  "Run mode hooks `delayed-mode-hooks' and HOOKS, or delay HOOKS.
+Execution is delayed if `delay-mode-hooks' is non-nil.
+Major mode functions should use this."
+  (if delay-mode-hooks
+      ;; Delaying case.
+      (dolist (hook hooks)
+	(push hook delayed-mode-hooks))
+    ;; Normal case, just run the hook as before plus any delayed hooks.
+    (setq hooks (nconc (nreverse delayed-mode-hooks) hooks))
+    (setq delayed-mode-hooks nil)
+    (apply 'run-hooks hooks)))
+
+(defmacro delay-mode-hooks (&rest body)
+  "Execute BODY, but delay any `run-mode-hooks'.
+Only affects hooks run in the current buffer."
+  `(progn
+    (make-local-variable 'delay-mode-hooks)
+    (let ((delay-mode-hooks t))
+      ,@body)))
+;; END FSF 21.3 SYNCH
+
 ;; Moved from mule-coding.el.
 (defmacro with-string-as-buffer-contents (str &rest body)
   "With the contents of the current buffer being STR, run BODY.