;; 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:
(make-local-hook hook)
(add-one-shot-hook hook function append t))
-(defun add-to-list (list-var element)
+(defun add-to-list (list-var element &optional append)
"Add to the value of LIST-VAR the element ELEMENT if it isn't there yet.
The test for presence of ELEMENT is done with `equal'.
+If ELEMENT is added, it is added at the beginning of the list,
+unless the optional argument APPEND is non-nil, in which case
+ELEMENT is added at the end.
+
If you want to use `add-to-list' on a variable that is not defined
until a certain package is loaded, you should put the call to `add-to-list'
into a hook function that will be run only after loading the package.
`eval-after-load' provides one way to do this. In some cases
other hooks, such as major mode hooks, can do the job."
- (or (member element (symbol-value list-var))
- (set list-var (cons element (symbol-value list-var)))))
+ (if (member element (symbol-value list-var))
+ (symbol-value list-var)
+ (set list-var
+ (if append
+ (append (symbol-value list-var) (list element))
+ (cons element (symbol-value list-var))))))
;; XEmacs additions
;; called by Fkill_buffer()
NOTE: At some point, this will be moved into C and will be very fast."
(with-current-buffer buffer
(set sym val)))
-
+
;;;; String functions.
;; XEmacs
(check-argument-type 'stringp str)
(check-argument-type 'stringp newtext)
(if (> (length str) 50)
- (with-temp-buffer
- (insert str)
- (goto-char 1)
+ (let ((cfs case-fold-search))
+ (with-temp-buffer
+ (setq case-fold-search cfs)
+ (insert str)
+ (goto-char 1)
(while (re-search-forward regexp nil t)
(replace-match newtext t literal))
- (buffer-string))
+ (buffer-string)))
(let ((start 0) newstr)
(while (string-match regexp str start)
(setq newstr (replace-match newtext t literal str)
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.
(set-buffer ,buffer)
,@body))
-(defmacro with-temp-file (file &rest forms)
- "Create a new buffer, evaluate FORMS there, and write the buffer to FILE.
+(defmacro with-temp-file (filename &rest forms)
+ "Create a new buffer, evaluate FORMS there, and write the buffer to FILENAME.
The value of the last form in FORMS is returned, like `progn'.
See also `with-temp-buffer'."
(let ((temp-file (make-symbol "temp-file"))
(temp-buffer (make-symbol "temp-buffer")))
- `(let ((,temp-file ,file)
+ `(let ((,temp-file ,filename)
(,temp-buffer
(get-buffer-create (generate-new-buffer-name " *temp file*"))))
(unwind-protect
(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.
;; getf, remf in cl*.el.
-(defmacro putf (plist prop val)
- "Add property PROP to plist PLIST with value VAL.
-Analogous to (setq PLIST (plist-put PLIST PROP VAL))."
- `(setq ,plist (plist-put ,plist ,prop ,val)))
+(defmacro putf (plist property value)
+ "Add property PROPERTY to plist PLIST with value VALUE.
+Analogous to (setq PLIST (plist-put PLIST PROPERTY VALUE))."
+ `(setq ,plist (plist-put ,plist ,property ,value)))
-(defmacro laxputf (lax-plist prop val)
- "Add property PROP to lax plist LAX-PLIST with value VAL.
-Analogous to (setq LAX-PLIST (lax-plist-put LAX-PLIST PROP VAL))."
- `(setq ,lax-plist (lax-plist-put ,lax-plist ,prop ,val)))
+(defmacro laxputf (lax-plist property value)
+ "Add property PROPERTY to lax plist LAX-PLIST with value VALUE.
+Analogous to (setq LAX-PLIST (lax-plist-put LAX-PLIST PROPERTY VALUE))."
+ `(setq ,lax-plist (lax-plist-put ,lax-plist ,property ,value)))
-(defmacro laxremf (lax-plist prop)
- "Remove property PROP from lax plist LAX-PLIST.
-Analogous to (setq LAX-PLIST (lax-plist-remprop LAX-PLIST PROP))."
- `(setq ,lax-plist (lax-plist-remprop ,lax-plist ,prop)))
+(defmacro laxremf (lax-plist property)
+ "Remove property PROPERTY from lax plist LAX-PLIST.
+Analogous to (setq LAX-PLIST (lax-plist-remprop LAX-PLIST PROPERTY))."
+ `(setq ,lax-plist (lax-plist-remprop ,lax-plist ,property)))
\f
;;; Error functions
malformed-property-list
circular-list
circular-property-list
+ invalid-regexp
+ specifier-syntax-error
+
invalid-argument
wrong-type-argument
wrong-number-of-arguments
invalid-function
no-catch
+ undefined-keystroke-sequence
+ specifier-argument-error
invalid-state
void-function
cyclic-function-indirection
void-variable
cyclic-variable-indirection
+ protected-field
+ invalid-byte-code
invalid-operation
invalid-change
setting-constant
+ specifier-change-error
editing-error
beginning-of-buffer
end-of-buffer
buffer-read-only
io-error
+ file-error
+ file-already-exists
+ file-locked
+ file-supersession
end-of-file
+ coding-system-error
+ image-conversion-error
+ tooltalk-error
arith-error
range-error
domain-error
singularity-error
overflow-error
underflow-error
+ dialog-box-error
+ search-failed
+ selection-conversion-error
+
+ unimplemented
+
+ internal-error
The five most common errors you will probably use or base your new
errors off of are `syntax-error', `invalid-argument', `invalid-state',
;;;; Miscellanea.
;; This is now in C.
-;(defun buffer-substring-no-properties (beg end)
-; "Return the text from BEG to END, without text properties, as a string."
-; (let ((string (buffer-substring beg end)))
+;(defun buffer-substring-no-properties (start end)
+; "Return the text from START to END, without text properties, as a string."
+; (let ((string (buffer-substring start end)))
; (set-text-properties 0 (length string) nil string)
; string))
projects / chise / xemacs-chise.git.1 / blobdiff