;;; subr.el --- basic lisp subroutines for Emacs
-;;; Copyright (C) 1985, 1986, 1992, 1994 Free Software Foundation, Inc.
+;;; Copyright (C) 1985, 1986, 1992, 1994, 1995 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
funcall or mapcar, etc.
ARGS should take the same form as an argument list for a `defun'.
-DOCSTRING should be a string, as described for `defun'. It may be omitted.
+DOCSTRING is an optional documentation string.
+ If present, it should describe how to call the function.
+ But documentation strings are usually not useful in nameless functions.
INTERACTIVE should be a call to the function `interactive', which see.
It may also be omitted.
BODY should be a list of lisp expressions."
;; 'args))))
\f
-;;;; Window tree functions.
-
-(defun one-window-p (&optional nomini all-frames)
- "Returns non-nil if the selected window is the only window (in its frame).
-Optional arg NOMINI non-nil means don't count the minibuffer
-even if it is active.
-
-The optional arg ALL-FRAMES t means count windows on all frames.
-If it is `visible', count windows on all visible frames.
-ALL-FRAMES nil or omitted means count only the selected frame,
-plus the minibuffer it uses (which may be on another frame).
-If ALL-FRAMES is neither nil nor t, count only the selected frame."
- (let ((base-window (selected-window)))
- (if (and nomini (eq base-window (minibuffer-window)))
- (setq base-window (next-window base-window)))
- (eq base-window
- (next-window base-window (if nomini 'arg) all-frames))))
-
-(defun walk-windows (proc &optional minibuf all-frames)
- "Cycle through all visible windows, calling PROC for each one.
-PROC is called with a window as argument.
-Optional second arg MINIBUF t means count the minibuffer window
-even if not active. If MINIBUF is neither t nor nil it means
-not to count the minibuffer even if it is active.
-
-Optional third arg ALL-FRAMES, if t, means include all frames.
-ALL-FRAMES nil or omitted means cycle within the selected frame,
-but include the minibuffer window (if MINIBUF says so) that that
-frame uses, even if it is on another frame.
-If ALL-FRAMES is neither nil nor t, stick strictly to the selected frame."
- ;; If we start from the minibuffer window, don't fail to come back to it.
- (if (window-minibuffer-p (selected-window))
- (setq minibuf t))
- (let* ((walk-windows-start (selected-window))
- (walk-windows-current walk-windows-start))
- (while (progn
- (setq walk-windows-current
- (next-window walk-windows-current minibuf all-frames))
- (funcall proc walk-windows-current)
- (not (eq walk-windows-current walk-windows-start))))))
-
-(defun minibuffer-window-active-p (window)
- "Return t if WINDOW (a minibuffer window) is now active."
- ;; nil nil means include WINDOW's frame
- ;; and other frames using WINDOW as minibuffer,
- ;; and include minibuffer if active.
- (let ((prev (previous-window window nil nil)))
- ;; If PREV equals WINDOW, WINDOW must be on a minibuffer-only frame
- ;; and it's not currently being used. So return nil.
- (and (not (eq window prev))
- (let ((should-be-same (next-window prev nil nil)))
- ;; If next-window doesn't reverse previous-window,
- ;; WINDOW must be outside the cycle specified by nil nil.
- (eq should-be-same window)))))
-\f
;;;; Keymap support.
(defun undefined ()
(if (and (keymapp defn)
;; Avoid recursively scanning
;; where KEYMAP does not have a submap.
- (keymapp (lookup-key keymap prefix1))
+ (let ((elt (lookup-key keymap prefix1)))
+ (or (null elt)
+ (keymapp elt)))
;; Avoid recursively rescanning keymap being scanned.
(not (memq inner-def
key-substitution-in-progress)))
(define-key keymap prefix1
(nconc (nreverse skipped) newdef))
(if (and (keymapp defn)
- (keymapp (lookup-key keymap prefix1))
+ (let ((elt (lookup-key keymap prefix1)))
+ (or (null elt)
+ (keymapp elt)))
(not (memq inner-def
key-substitution-in-progress)))
(substitute-key-definition olddef newdef keymap
\f
;;;; Hook manipulation functions.
-(defun run-hooks (&rest hooklist)
- "Takes hook names and runs each one in turn. Major mode functions use this.
-Each argument should be a symbol, a hook variable.
-These symbols are processed in the order specified.
-If a hook symbol has a non-nil value, that value may be a function
-or a list of functions to be called to run the hook.
-If the value is a function, it is called with no arguments.
-If it is a list, the elements are called, in order, with no arguments.
-
-To make a hook variable buffer-local, use `make-local-hook', not
-`make-local-variable'."
- (while hooklist
- (let ((sym (car hooklist)))
- (and (boundp sym)
- (symbol-value sym)
- (let ((value (symbol-value sym)))
- (if (and (listp value) (not (eq (car value) 'lambda)))
- (while value
- (if (eq (car value) t)
- ;; t indicates this hook has a local binding;
- ;; it means to run the global binding too.
- (let ((functions (default-value sym)))
- (while functions
- (funcall (car functions))
- (setq functions (cdr functions))))
- (funcall (car value)))
- (setq value (cdr value)))
- (funcall value)))))
- (setq hooklist (cdr hooklist))))
-
-(defun run-hook-with-args (hook &rest args)
- "Run HOOK with the specified arguments ARGS.
-HOOK should be a symbol, a hook variable. If HOOK has a non-nil
-value, that value may be a function or a list of functions to be
-called to run the hook. If the value is a function, it is called with
-the given arguments and its return value is returned. If it is a list
-of functions, those functions are called, in order,
-with the given arguments ARGS.
-It is best not to depend on the value return by `run-hook-with-args',
-as that may change.
-
-To make a hook variable buffer-local, use `make-local-hook', not
-`make-local-variable'."
- (and (boundp hook)
- (symbol-value hook)
- (let ((value (symbol-value hook)))
- (if (and (listp value) (not (eq (car value) 'lambda)))
- (while value
- (if (eq (car value) t)
- ;; t indicates this hook has a local binding;
- ;; it means to run the global binding too.
- (let ((functions (default-value hook)))
- (while functions
- (apply (car functions) args)
- (setq functions (cdr functions))))
- (apply (car value) args))
- (setq value (cdr value)))
- (apply value args)))))
-
-(defun run-hook-with-args-until-success (hook &rest args)
- "Run HOOK with the specified arguments ARGS.
-HOOK should be a symbol, a hook variable. Its value should
-be a list of functions. We call those functions, one by one,
-passing arguments ARGS to each of them, until one of them
-returns a non-nil value. Then we return that value.
-If all the functions return nil, we return nil.
-
-To make a hook variable buffer-local, use `make-local-hook', not
-`make-local-variable'."
- (and (boundp hook)
- (symbol-value hook)
- (let ((value (symbol-value hook))
- success)
- (while (and value (not success))
- (if (eq (car value) t)
- ;; t indicates this hook has a local binding;
- ;; it means to run the global binding too.
- (let ((functions (default-value hook)))
- (while (and functions (not success))
- (setq success (apply (car functions) args))
- (setq functions (cdr functions))))
- (setq success (apply (car value) args)))
- (setq value (cdr value)))
- success)))
-
-(defun run-hook-with-args-until-failure (hook &rest args)
- "Run HOOK with the specified arguments ARGS.
-HOOK should be a symbol, a hook variable. Its value should
-be a list of functions. We call those functions, one by one,
-passing arguments ARGS to each of them, until one of them
-returns nil. Then we return nil.
-If all the functions return non-nil, we return non-nil.
-
-To make a hook variable buffer-local, use `make-local-hook', not
-`make-local-variable'."
- ;; We must return non-nil if there are no hook functions!
- (or (not (boundp hook))
- (not (symbol-value hook))
- (let ((value (symbol-value hook))
- (success t))
- (while (and value success)
- (if (eq (car value) t)
- ;; t indicates this hook has a local binding;
- ;; it means to run the global binding too.
- (let ((functions (default-value hook)))
- (while (and functions success)
- (setq success (apply (car functions) args))
- (setq functions (cdr functions))))
- (setq success (apply (car value) args)))
- (setq value (cdr value)))
- success)))
-
-;; Tell C code how to call this function.
+;; We used to have this variable so that C code knew how to run hooks. That
+;; calling convention is made obsolete now the hook running functions are in C.
(defconst run-hooks 'run-hooks
"Variable by which C primitives find the function `run-hooks'.
-Don't change it.")
+Don't change it. Don't use it either; use the hook running C primitives.")
(defun make-local-hook (hook)
"Make the hook HOOK local to the current buffer.
functions listed in *either* the local value *or* the global value
of the hook variable.
-This function does nothing if HOOK is already local in the current buffer.
+This function works by making `t' a member of the buffer-local value,
+which acts as a flag to run the hook functions in the default value as
+well. This works for all normal hooks, but does not work for most
+non-normal hooks yet. We will be changing the callers of non-normal
+hooks so that they can handle localness; this has to be done one by
+one.
+
+This function does nothing if HOOK is already local in the current
+buffer.
Do not use `make-local-variable' to make a hook variable buffer-local."
(if (local-variable-p hook)
(if (or local
;; Detect the case where make-local-variable was used on a hook
;; and do what we used to do.
- (and (local-variable-p hook)
+ (and (local-variable-if-set-p hook)
(not (memq t (symbol-value hook)))))
;; Alter the local value only.
(or (if (consp function)
(let ((message-log-max nil) (count 0) (code 0) char)
(while (< count 3)
(let ((inhibit-quit (zerop count))
- (help-form nil))
+ ;; Don't let C-h get the help message--only help function keys.
+ (help-char nil)
+ (help-form
+ "Type the special character you want to use,
+or three octal digits representing its character code."))
(and prompt (message "%s-" prompt))
(setq char (read-char))
(if inhibit-quit (setq quit-flag nil)))
(defmacro save-match-data (&rest body)
"Execute the BODY forms, restoring the global value of the match data."
(let ((original (make-symbol "match-data")))
- (list
- 'let (list (list original '(match-data)))
- (list 'unwind-protect
- (cons 'progn body)
- (list 'store-match-data original)))))
-
-(defun match-string (n &optional string)
- "Return the Nth subexpression matched by the last regexp search or match.
-If the last search or match was done against a string,
-specify that string as the second argument STRING."
- (if string
- (substring string (match-beginning n) (match-end n))
- (buffer-substring (match-beginning n) (match-end n))))
+ (list 'let (list (list original '(match-data)))
+ (list 'unwind-protect
+ (cons 'progn body)
+ (list 'store-match-data original)))))
+
+(defun match-string (num &optional string)
+ "Return string of text matched by last search.
+NUM specifies which parenthesized expression in the last regexp.
+ Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
+Zero means the entire text matched by the whole regexp or whole string.
+STRING should be given if the last search was by `string-match' on STRING."
+ (if (match-beginning num)
+ (if string
+ (substring string (match-beginning num) (match-end num))
+ (buffer-substring (match-beginning num) (match-end num)))))
+
+(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)))
+ (set-text-properties 0 (length string) nil string)
+ string))
(defun shell-quote-argument (argument)
"Quote an argument for passing as argument to an inferior shell."
- ;; Quote everything except POSIX filename characters.
- ;; This should be safe enough even for really weird shells.
- (let ((result "") (start 0) end)
- (while (string-match "[^-0-9a-zA-Z_./]" argument start)
- (setq end (match-beginning 0)
- result (concat result (substring argument start end)
- "\\" (substring argument end (1+ end)))
- start (1+ end)))
- (concat result (substring argument start))))
+ (if (eq system-type 'ms-dos)
+ ;; MS-DOS shells don't have quoting, so don't do any.
+ argument
+ (if (eq system-type 'windows-nt)
+ (concat "\"" argument "\"")
+ ;; Quote everything except POSIX filename characters.
+ ;; This should be safe enough even for really weird shells.
+ (let ((result "") (start 0) end)
+ (while (string-match "[^-0-9a-zA-Z_./]" argument start)
+ (setq end (match-beginning 0)
+ result (concat result (substring argument start end)
+ "\\" (substring argument end (1+ end)))
+ start (1+ end)))
+ (concat result (substring argument start))))))
(defun make-syntax-table (&optional oldtable)
"Return a new syntax table.
(interactive "kUnset key globally: ")
(global-set-key key nil))
-(defun local-unset-key
+(defun local-unset-key (key)
"Remove local binding of KEY.
KEY is a string representing a sequence of keystrokes."
(interactive "kUnset key locally: ")
(if (current-local-map)
- (local-set-key (current-local-map) key nil))
+ (local-set-key key nil))
nil)
\f
+;; We put this here instead of in frame.el so that it's defined even on
+;; systems where frame.el isn't loaded.
+(defun frame-configuration-p (object)
+ "Return non-nil if OBJECT seems to be a frame configuration.
+Any list whose car is `frame-configuration' is assumed to be a frame
+configuration."
+ (and (consp object)
+ (eq (car object) 'frame-configuration)))
+
;; now in fns.c
;(defun nth (n list)
; "Returns the Nth element of LIST.
HCoop / bpt / emacs.git / blobdiff