]> code.delx.au - gnu-emacs/blobdiff - lisp/subr.el
Rename `MS-DOG' into `MS-DOS'.
[gnu-emacs] / lisp / subr.el
index ac917a105502f655a27c5dd18816ad26523cbca5..82d60a34d5f282e38e2f62c528c31217d01bf644 100644 (file)
@@ -1,7 +1,7 @@
 ;;; subr.el --- basic lisp subroutines for Emacs
 
 ;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1999, 2000, 2001, 2002, 2003,
-;;   2004, 2005 Free Software Foundation, Inc.
+;;   2004, 2005, 2006 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: internal
@@ -561,8 +561,10 @@ In other words, OLDDEF is replaced with NEWDEF where ever it appears.
 Alternatively, if optional fourth argument OLDMAP is specified, we redefine
 in KEYMAP as NEWDEF those keys which are defined as OLDDEF in OLDMAP.
 
-For most uses, it is simpler and safer to use command remappping like this:
-  \(define-key KEYMAP [remap OLDDEF] NEWDEF)"
+If you don't specify OLDMAP, you can usually get the same results
+in a cleaner way with command remapping, like this:
+  \(define-key KEYMAP [remap OLDDEF] NEWDEF)
+\n(fn OLDDEF NEWDEF KEYMAP &optional OLDMAP)"
   ;; Don't document PREFIX in the doc string because we don't want to
   ;; advertise it.  It's meant for recursive calls only.  Here's its
   ;; meaning
@@ -607,8 +609,7 @@ For most uses, it is simpler and safer to use command remappping like this:
            (nconc (nreverse skipped) newdef)))
       ;; Look past a symbol that names a keymap.
       (setq inner-def
-           (and defn
-                (condition-case nil (indirect-function defn) (error defn))))
+           (or (indirect-function defn t) defn))
       ;; For nested keymaps, we use `inner-def' rather than `defn' so as to
       ;; avoid autoloading a keymap.  This is mostly done to preserve the
       ;; original non-autoloading behavior of pre-map-keymap times.
@@ -850,19 +851,23 @@ and `event-end' functions."
   (nth 3 position))
 
 (defsubst posn-string (position)
-  "Return the string object of POSITION, or nil if a buffer position.
+  "Return the string object of POSITION.
+Value is a cons (STRING . STRING-POS), or nil if not a string.
 POSITION should be a list of the form returned by the `event-start'
 and `event-end' functions."
   (nth 4 position))
 
 (defsubst posn-image (position)
-  "Return the image object of POSITION, or nil if a not an image.
+  "Return the image object of POSITION.
+Value is an list (image ...), or nil if not an image.
 POSITION should be a list of the form returned by the `event-start'
 and `event-end' functions."
   (nth 7 position))
 
 (defsubst posn-object (position)
   "Return the object (image or string) of POSITION.
+Value is a list (image ...) for an image object, a cons cell
+\(STRING . STRING-POS) for a string object, and nil for a buffer position.
 POSITION should be a list of the form returned by the `event-start'
 and `event-end' functions."
   (or (posn-image position) (posn-string position)))
@@ -1117,6 +1122,32 @@ The return value is the new value of LIST-VAR."
                            (if (and oa ob)
                                (< oa ob)
                              oa)))))))
+
+(defun add-to-history (history-var newelt &optional maxelt keep-dups)
+  "Add NEWELT to the history list stored in the variable HISTORY-VAR.
+Return the new history list.
+If MAXELT is non-nil, it specifies the maximum length of the history.
+Otherwise, the maximum history length is the value of the `history-length'
+property on symbol HISTORY-VAR, if set, or the value of the `history-length'
+variable.
+Remove duplicates of NEWELT unless `history-delete-duplicates' is nil
+or KEEP-DUPS is non-nil."
+  (unless maxelt
+    (setq maxelt (or (get history-var 'history-length)
+                    history-length)))
+  (let ((history (symbol-value history-var))
+       tail)
+    (if (and history-delete-duplicates (not keep-dups))
+       (setq history (delete newelt history)))
+    (setq history (cons newelt history))
+    (when (integerp maxelt)
+      (if (= 0 maxelt)
+         (setq history nil)
+       (setq tail (nthcdr (1- maxelt) history))
+       (when (consp tail)
+         (setcdr tail nil))))
+    (set history-var history)))
+
 \f
 ;;;; Mode hooks.
 
@@ -1257,25 +1288,25 @@ If TOGGLE has a `:menu-tag', that is used for the menu item's label."
 \f
 ;;; Load history
 
-;;; (defvar symbol-file-load-history-loaded nil
-;;;   "Non-nil means we have loaded the file `fns-VERSION.el' in `exec-directory'.
-;;; That file records the part of `load-history' for preloaded files,
-;;; which is cleared out before dumping to make Emacs smaller.")
-
-;;; (defun load-symbol-file-load-history ()
-;;;   "Load the file `fns-VERSION.el' in `exec-directory' if not already done.
-;;; That file records the part of `load-history' for preloaded files,
-;;; which is cleared out before dumping to make Emacs smaller."
-;;;   (unless symbol-file-load-history-loaded
-;;;     (load (expand-file-name
-;;;       ;; fns-XX.YY.ZZ.el does not work on DOS filesystem.
-;;;       (if (eq system-type 'ms-dos)
-;;;           "fns.el"
-;;;         (format "fns-%s.el" emacs-version))
-;;;       exec-directory)
-;;;      ;; The file name fns-%s.el already has a .el extension.
-;;;      nil nil t)
-;;;     (setq symbol-file-load-history-loaded t)))
+;; (defvar symbol-file-load-history-loaded nil
+;;   "Non-nil means we have loaded the file `fns-VERSION.el' in `exec-directory'.
+;; That file records the part of `load-history' for preloaded files,
+;; which is cleared out before dumping to make Emacs smaller.")
+
+;; (defun load-symbol-file-load-history ()
+;;   "Load the file `fns-VERSION.el' in `exec-directory' if not already done.
+;; That file records the part of `load-history' for preloaded files,
+;; which is cleared out before dumping to make Emacs smaller."
+;;   (unless symbol-file-load-history-loaded
+;;     (load (expand-file-name
+;;        ;; fns-XX.YY.ZZ.el does not work on DOS filesystem.
+;;        (if (eq system-type 'ms-dos)
+;;            "fns.el"
+;;          (format "fns-%s.el" emacs-version))
+;;        exec-directory)
+;;       ;; The file name fns-%s.el already has a .el extension.
+;;       nil nil t)
+;;     (setq symbol-file-load-history-loaded t)))
 
 (defun symbol-file (symbol &optional type)
   "Return the input source in which SYMBOL was defined.
@@ -1323,12 +1354,13 @@ string.  When run interactively, the argument INTERACTIVE-CALL is t,
 and the file name is displayed in the echo area."
   (interactive (list (completing-read "Locate library: "
                                      'locate-file-completion
-                                     (cons load-path load-suffixes))
+                                     (cons load-path (get-load-suffixes)))
                     nil nil
                     t))
   (let ((file (locate-file library
                           (or path load-path)
-                          (append (unless nosuffix load-suffixes) '("")))))
+                          (append (unless nosuffix (get-load-suffixes))
+                                  load-file-rep-suffixes))))
     (if interactive-call
        (if file
            (message "Library is file %s" (abbreviate-file-name file))
@@ -1538,7 +1570,8 @@ by doing (clear-string STRING)."
       (let ((pass nil)
            (c 0)
            (echo-keystrokes 0)
-           (cursor-in-echo-area t))
+           (cursor-in-echo-area t)
+           (message-log-max nil))
        (add-text-properties 0 (length prompt)
                             minibuffer-prompt-properties prompt)
        (while (progn (message "%s%s"
@@ -1831,6 +1864,12 @@ mode.")
 This variable is meaningful on MS-DOG and Windows NT.
 On those systems, it is automatically local in every buffer.
 On other systems, this variable is normally always nil.")
+
+;; The `assert' macro from the cl package signals
+;; `cl-assertion-failed' at runtime so always define it.
+(put 'cl-assertion-failed 'error-conditions '(error))
+(put 'cl-assertion-failed 'error-message "Assertion failed")
+
 \f
 ;;;; Misc. useful functions.
 
@@ -1908,6 +1947,16 @@ a system-dependent default device name is used."
                                 "\\" (substring argument end (1+ end)))
                  start (1+ end)))
          (concat result (substring argument start)))))))
+
+(defun string-or-null-p (object)
+  "Return t if OBJECT is a string or nil.
+Otherwise, return nil."
+  (or (stringp object) (null object)))
+
+(defun booleanp (object)
+  "Return non-nil if OBJECT is one of the two canonical boolean values: t or nil."
+  (memq object '(nil t)))
+
 \f
 ;;;; Support for yanking and text properties.
 
@@ -2274,7 +2323,9 @@ as an argument to `try-completion'), the function FUN is called with no
 arguments.  FUN must return the completion table that will be stored in VAR.
 If completion is requested in the minibuffer, FUN will be called in the buffer
 from which the minibuffer was entered.  The return value of
-`lazy-completion-table' must be used to initialize the value of VAR."
+`lazy-completion-table' must be used to initialize the value of VAR.
+
+You should give VAR a non-nil `risky-local-variable' property."
   (declare (debug (symbol lambda-expr)))
   (let ((str (make-symbol "string")))
     `(dynamic-completion-table