Comment changes.
[bpt/emacs.git] / lisp / subr.el
index 14ae2ba..014217e 100644 (file)
@@ -24,7 +24,7 @@
   "Record `defcustom' calls made before `custom.el' is loaded to handle them.
 Each element of this list holds the arguments to one call to `defcustom'.")
 
-;; Use this rather that defcustom, in subr.el and other files loaded
+;; Use this, rather than defcustom, in subr.el and other files loaded
 ;; before custom.el.
 (defun custom-declare-variable-early (&rest arguments)
   (setq custom-declare-variable-list
@@ -62,6 +62,37 @@ BODY should be a list of lisp expressions."
   (cons 'if (cons cond (cons nil body))))
 (put 'unless 'lisp-indent-function 1)
 (put 'unless 'edebug-form-spec '(&rest form))
+
+(defsubst caar (x)
+  "Return the car of the car of X."
+  (car (car x)))
+
+(defsubst cadr (x)
+  "Return the car of the cdr of X."
+  (car (cdr x)))
+
+(defsubst cdar (x)
+  "Return the cdr of the car of X."
+  (cdr (car x)))
+
+(defsubst cddr (x)
+  "Return the cdr of the cdr of X."
+  (cdr (cdr x)))
+
+(defun last (x &optional n)
+  "Return the last link of the list X.  Its car is the last element.
+If X is nil, return nil.
+If N is non-nil, return the Nth-to-last link of X.
+If N is bigger than the length of X, return X."
+  (if n
+      (let ((m 0) (p x))
+       (while (consp p)
+         (setq m (1+ m) p (cdr p)))
+       (if (<= n 0) p
+         (if (< n m) (nthcdr (- m n) x) x)))
+    (while (cdr x)
+      (setq x (cdr x)))
+    x))
 \f
 ;;;; Keymap support.
 
@@ -480,6 +511,15 @@ as returned by the `event-start' and `event-end' functions."
 (defalias 'compiled-function-p 'byte-code-function-p)
 (defalias 'define-function 'defalias)
 
+(defun sref (string byte-index)
+  "Obsolete function returning a character in STRING at BYTE-INDEX.
+Please convert your programs to use `aref' with character-base index."
+  (let ((byte 0) (char 0))
+    (while (< byte byte-index)
+      (setq byte (+ byte (char-bytes (aref string char)))
+           char (1+ char)))
+    (aref string char)))
+
 ;; Some programs still use this as a function.
 (defun baud-rate ()
   "Obsolete function returning the value of the `baud-rate' variable.
@@ -503,7 +543,7 @@ Please convert your programs to use the variable `baud-rate' directly."
 (defalias 'search-forward-regexp (symbol-function 're-search-forward))
 (defalias 'search-backward-regexp (symbol-function 're-search-backward))
 (defalias 'int-to-string 'number-to-string)
-(defalias 'set-match-data 'store-match-data)
+(defalias 'store-match-data 'set-match-data)
 
 ;;; Should this be an obsolete name?  If you decide it should, you get
 ;;; to go through all the sources and change them.
@@ -592,7 +632,7 @@ This makes no difference if the hook is not buffer-local.
 To make a hook variable buffer-local, always use
 `make-local-hook', not `make-local-variable'."
   (if (or (not (boundp hook))          ;unbound symbol, or
-         (not (default-boundp 'hook))
+         (not (default-boundp hook))
          (null (symbol-value hook))    ;value is nil, or
          (null function))              ;function is nil, then
       nil                              ;Do nothing.
@@ -624,8 +664,9 @@ 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 (cons element (symbol-value list-var)))))
 \f
 ;;;; Specifying things to do after certain files are loaded.
 
@@ -672,11 +713,13 @@ Legitimate radix values are 8, 10 and 16."
   "Like `read-char', but do not allow quitting.
 Also, if the first character read is an octal digit,
 we read any number of octal digits and return the
-soecified character code.  Any nondigit terminates the sequence.
+specified character code.  Any nondigit terminates the sequence.
 If the terminator is RET, it is discarded;
 any other terminator is used itself as input.
 
-The optional argument PROMPT specifies a string to use to prompt the user."
+The optional argument PROMPT specifies a string to use to prompt the user.
+The variable `read-quoted-char-radix' controls which radix to use
+for numeric input."
   (let ((message-log-max nil) done (first t) (code 0) char)
     (while (not done)
       (let ((inhibit-quit first)
@@ -693,18 +736,23 @@ any other non-digit terminates the character code and is then used as input."))
       ;; Translate TAB key into control-I ASCII character, and so on.
       (and char
           (let ((translated (lookup-key function-key-map (vector char))))
-            (if translated
+            (if (arrayp translated)
                 (setq char (aref translated 0)))))
       (cond ((null char))
            ((not (integerp char))
             (setq unread-command-events (list char)
                   done t))
+           ((/= (logand char ?\M-\^@) 0)
+            ;; Turn a meta-character into a character with the 0200 bit set.
+            (setq code (logior (logand char (lognot ?\M-\^@)) 128)
+                  done t))
            ((and (<= ?0 char) (< char (+ ?0 (min 10 read-quoted-char-radix))))
             (setq code (+ (* code read-quoted-char-radix) (- char ?0)))
             (and prompt (setq prompt (message "%s %c" prompt char))))
            ((and (<= ?a (downcase char))
                  (< (downcase char) (+ ?a -10 (min 26 read-quoted-char-radix))))
-            (setq code (+ (* code read-quoted-char-radix) (+ 10 (- char ?a))))
+            (setq code (+ (* code read-quoted-char-radix)
+                          (+ 10 (- (downcase char) ?a))))
             (and prompt (setq prompt (message "%s %c" prompt char))))
            ((and (not first) (eq char ?\C-m))
             (setq done t))
@@ -714,10 +762,41 @@ any other non-digit terminates the character code and is then used as input."))
            (t (setq code char
                     done t)))
       (setq first nil))
-    ;; Turn a meta-character into a character with the 0200 bit set.
-    (logior (if (/= (logand code ?\M-\^@) 0) 128 0)
-           code)))
-
+    code))
+
+(defun read-passwd (prompt &optional confirm default)
+  "Read a password, prompting with PROMPT.  Echo `.' for each character typed.
+End with RET, LFD, or ESC.  DEL or C-h rubs out.  C-u kills line.
+Optional argument CONFIRM, if non-nil, then read it twice to make sure.
+Optional DEFAULT is a default password to use instead of empty input."
+  (if confirm
+      (let (success)
+       (while (not success)
+         (let ((first (read-passwd prompt nil default))
+               (second (read-passwd "Confirm password: " nil default)))
+           (if (equal first second)
+               (setq success first)
+             (message "Password not repeated accurately; please start over")
+             (sit-for 1))))
+       success)
+    (let ((pass nil)
+         (c 0)
+         (echo-keystrokes 0)
+         (cursor-in-echo-area t))
+      (while (progn (message "%s%s"
+                            prompt
+                            (make-string (length pass) ?.))
+                   (setq c (read-char))
+                   (and (/= c ?\r) (/= c ?\n) (/= c ?\e)))
+       (if (= c ?\C-u)
+           (setq pass "")
+         (if (and (/= c ?\b) (/= c ?\177))
+             (setq pass (concat pass (char-to-string c)))
+           (if (> (length pass) 0)
+               (setq pass (substring pass 0 -1))))))
+      (message nil)
+      (or pass default ""))))
+\f
 (defun force-mode-line-update (&optional all)
   "Force the mode-line of the current buffer to be redisplayed.
 With optional non-nil ALL, force redisplay of all mode-lines."
@@ -747,7 +826,7 @@ If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there."
            (insert-before-markers string)
            (setq insert-end (point))
            ;; If the message end is off screen, recenter now.
-           (if (> (window-end) insert-end)
+           (if (< (window-end nil t) insert-end)
                (recenter (/ (window-height) 2)))
            ;; If that pushed message start off the screen,
            ;; scroll to start it at the top of the screen.
@@ -774,6 +853,12 @@ If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there."
 ;; Give it a global value to avoid compiler warnings.
 (defvar font-lock-defaults nil)
 
+(defvar suspend-hook nil
+  "Normal hook run by `suspend-emacs', before suspending.")
+
+(defvar suspend-resume-hook nil
+  "Normal hook run by `suspend-emacs', after Emacs is continued.")
+
 ;; Avoid compiler warnings about this variable,
 ;; which has a special meaning on certain system types.
 (defvar buffer-file-type nil
@@ -909,7 +994,7 @@ in BODY."
   `(let ((save-match-data-internal (match-data)))
        (unwind-protect
           (progn ,@body)
-        (store-match-data save-match-data-internal))))
+        (set-match-data save-match-data-internal))))
 
 (defun match-string (num &optional string)
   "Return string of text matched by last search.
@@ -922,17 +1007,45 @@ STRING should be given if the last search was by `string-match' on STRING."
          (substring string (match-beginning num) (match-end num))
        (buffer-substring (match-beginning num) (match-end num)))))
 
+(defun match-string-no-properties (num &optional string)
+  "Return string of text matched by last search, without text properties.
+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
+         (let ((result
+                (substring string (match-beginning num) (match-end num))))
+           (set-text-properties 0 (length result) nil result)
+           result)
+       (buffer-substring-no-properties (match-beginning num)
+                                       (match-end num)))))
+
 (defun split-string (string &optional separators)
   "Splits STRING into substrings where there are matches for SEPARATORS.
 Each match for SEPARATORS is a splitting point.
 The substrings between the splitting points are made into a list
 which is returned.
-If SEPARATORS is absent, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
+If SEPARATORS is absent, it defaults to \"[ \\f\\t\\n\\r\\v]+\".
+
+If there is match for SEPARATORS at the beginning of STRING, we do not
+include a null substring for that.  Likewise, if there is a match
+at the end of STRING, we don't include a null substring for that."
   (let ((rexp (or separators "[ \f\t\n\r\v]+"))
        (start 0)
+       notfirst
        (list nil))
-    (while (string-match rexp string start)
+    (while (and (string-match rexp string
+                             (if (and notfirst
+                                      (= start (match-beginning 0))
+                                      (< start (length string)))
+                                 (1+ start) start))
+               (< (match-beginning 0) (length string)))
+      (setq notfirst t)
       (or (eq (match-beginning 0) 0)
+         (and (eq (match-beginning 0) (match-end 0))
+              (eq (match-beginning 0) start))
          (setq list
                (cons (substring string start (match-beginning 0))
                      list)))
@@ -1008,24 +1121,28 @@ that can be added."
 \f
 (defun global-set-key (key command)
   "Give KEY a global binding as COMMAND.
-COMMAND is a symbol naming an interactively-callable function.
-KEY is a key sequence (a string or vector of characters or event types).
-Non-ASCII characters with codes above 127 (such as ISO Latin-1)
-can be included if you use a vector.
-Note that if KEY has a local binding in the current buffer
-that local binding will continue to shadow any global binding."
+COMMAND is the command definition to use; usually it is
+a symbol naming an interactively-callable function.
+KEY is a key sequence; noninteractively, it is a string or vector
+of characters or event types, and non-ASCII characters with codes
+above 127 (such as ISO Latin-1) can be included if you use a vector.
+
+Note that if KEY has a local binding in the current buffer,
+that local binding will continue to shadow any global binding
+that you make with this function."
   (interactive "KSet key globally: \nCSet key %s to command: ")
   (or (vectorp key) (stringp key)
       (signal 'wrong-type-argument (list 'arrayp key)))
-  (define-key (current-global-map) key command)
-  nil)
+  (define-key (current-global-map) key command))
 
 (defun local-set-key (key command)
   "Give KEY a local binding as COMMAND.
-COMMAND is a symbol naming an interactively-callable function.
-KEY is a key sequence (a string or vector of characters or event types).
-Non-ASCII characters with codes above 127 (such as ISO Latin-1)
-can be included if you use a vector.
+COMMAND is the command definition to use; usually it is
+a symbol naming an interactively-callable function.
+KEY is a key sequence; noninteractively, it is a string or vector
+of characters or event types, and non-ASCII characters with codes
+above 127 (such as ISO Latin-1) can be included if you use a vector.
+
 The binding goes in the current buffer's local map,
 which in most cases is shared with all other buffers in the same major mode."
   (interactive "KSet key locally: \nCSet key %s locally to command: ")
@@ -1034,8 +1151,7 @@ which in most cases is shared with all other buffers in the same major mode."
        (use-local-map (setq map (make-sparse-keymap))))
     (or (vectorp key) (stringp key)
        (signal 'wrong-type-argument (list 'arrayp key)))
-    (define-key map key command))
-  nil)
+    (define-key map key command)))
 
 (defun global-unset-key (key)
   "Remove global binding of KEY.
@@ -1062,7 +1178,7 @@ configuration."
 
 (defun functionp (object)
   "Non-nil if OBJECT is a type of object that can be called as a function."
-  (or (subrp object) (compiled-function-p object)
+  (or (subrp object) (byte-code-function-p object)
       (eq (car-safe object) 'lambda)
       (and (symbolp object) (fboundp object))))