;;; subr.el --- basic lisp subroutines for Emacs
;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
;;; Commentary:
;;; Code:
+
(defvar custom-declare-variable-list nil
"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'.")
\(declare-function c-end-of-defun \"progmodes/cc-cmds.el\"
\(&optional arg))
-For more information, see Info node `elisp(Declaring Functions)'."
+For more information, see Info node `(elisp)Declaring Functions'."
;; Does nothing - byte-compile-declare-function does the work.
nil)
+
\f
;;;; Basic Lisp macros.
(defun keymap-canonicalize (map)
"Return an equivalent keymap, without inheritance."
(let ((bindings ())
- (ranges ()))
+ (ranges ())
+ (prompt (keymap-prompt map)))
(while (keymapp map)
(setq map (map-keymap-internal
(lambda (key item)
(push (cons key item) ranges)
(push (cons key item) bindings)))
map)))
- (setq map (funcall (if ranges 'make-keymap 'make-sparse-keymap)
- (keymap-prompt map)))
+ (setq map (funcall (if ranges 'make-keymap 'make-sparse-keymap) prompt))
(dolist (binding ranges)
;; Treat char-ranges specially.
(define-key map (vector (car binding)) (cdr binding)))
(defalias 'search-backward-regexp (symbol-function 're-search-backward))
(defalias 'int-to-string 'number-to-string)
(defalias 'store-match-data 'set-match-data)
+(defalias 'chmod 'set-file-modes)
+(defalias 'mkdir 'make-directory)
;; These are the XEmacs names:
(defalias 'point-at-eol 'line-end-position)
(defalias 'point-at-bol 'line-beginning-position)
Optional DEFAULT is a default password to use instead of empty input.
This function echoes `.' for each character that the user types.
-The user ends with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line.
+
+The user ends with RET, LFD, or ESC. DEL or C-h rubs out.
+C-y yanks the current kill. C-u kills line.
C-g quits; if `inhibit-quit' was non-nil around this function,
then it returns nil if the user types C-g, but quit-flag remains set.
(c 0)
(echo-keystrokes 0)
(cursor-in-echo-area t)
- (message-log-max nil))
+ (message-log-max nil)
+ (stop-keys (list 'return ?\r ?\n ?\e))
+ (rubout-keys (list 'backspace ?\b ?\177)))
(add-text-properties 0 (length prompt)
minibuffer-prompt-properties prompt)
(while (progn (message "%s%s"
prompt
(make-string (length pass) ?.))
- (setq c (read-char-exclusive nil t))
- (and (/= c ?\r) (/= c ?\n) (/= c ?\e)))
+ ;; We used to use read-char-exclusive, but that
+ ;; gives funny behavior when the user presses,
+ ;; e.g., the arrow keys.
+ (setq c (read-event nil t))
+ (not (memq c stop-keys)))
(clear-this-command-keys)
- (if (= c ?\C-u)
- (progn
- (and (arrayp pass) (clear-string pass))
- (setq pass ""))
- (if (and (/= c ?\b) (/= c ?\177))
- (let* ((new-char (char-to-string c))
- (new-pass (concat pass new-char)))
- (and (arrayp pass) (clear-string pass))
- (clear-string new-char)
- (setq c ?\0)
- (setq pass new-pass))
- (if (> (length pass) 0)
- (let ((new-pass (substring pass 0 -1)))
- (and (arrayp pass) (clear-string pass))
- (setq pass new-pass))))))
+ (cond ((memq c rubout-keys) ; rubout
+ (when (> (length pass) 0)
+ (let ((new-pass (substring pass 0 -1)))
+ (and (arrayp pass) (clear-string pass))
+ (setq pass new-pass))))
+ ((not (numberp c)))
+ ((= c ?\C-u) ; kill line
+ (and (arrayp pass) (clear-string pass))
+ (setq pass ""))
+ ((= c ?\C-y) ; yank
+ (let* ((str (condition-case nil
+ (current-kill 0)
+ (error nil)))
+ new-pass)
+ (when str
+ (setq new-pass
+ (concat pass
+ (substring-no-properties str)))
+ (and (arrayp pass) (clear-string pass))
+ (setq c ?\0)
+ (setq pass new-pass))))
+ ((characterp c) ; insert char
+ (let* ((new-char (char-to-string c))
+ (new-pass (concat pass new-char)))
+ (and (arrayp pass) (clear-string pass))
+ (clear-string new-char)
+ (setq c ?\0)
+ (setq pass new-pass)))))
(message nil)
(or pass default "")))))
"~/.emacs.d/")
"Directory beneath which additional per-user Emacs-specific files are placed.
Various programs in Emacs store information in this directory.
-Note that this should end with a directory separator.")
+Note that this should end with a directory separator.
+See also `locate-user-emacs-file'.")
+
+(defun locate-user-emacs-file (new-name &optional old-name)
+ "Return an absolute per-user Emacs-specific file name.
+If OLD-NAME is non-nil and ~/OLD-NAME exists, return ~/OLD-NAME.
+Else return NEW-NAME in `user-emacs-directory', creating the
+directory if it does not exist."
+ (convert-standard-filename
+ (let* ((home (concat "~" (or init-file-user "")))
+ (at-home (and old-name (expand-file-name old-name home))))
+ (if (and at-home (file-readable-p at-home))
+ at-home
+ ;; Make sure `user-emacs-directory' exists,
+ ;; unless we're in batch mode or dumping Emacs
+ (or noninteractive
+ purify-flag
+ (file-accessible-directory-p (directory-file-name user-emacs-directory))
+ (make-directory user-emacs-directory))
+ (expand-file-name new-name user-emacs-directory)))))
\f
;;;; Misc. useful functions.
\f
;;;; Lisp macros to do various things temporarily.
-(defmacro with-current-buffer (buffer &rest body)
- "Execute the forms in BODY with BUFFER temporarily current.
-BUFFER can be a buffer or a buffer name.
-The value returned is the value of the last form in BODY.
-See also `with-temp-buffer'."
+(defmacro with-current-buffer (buffer-or-name &rest body)
+ "Execute the forms in BODY with BUFFER-OR-NAME temporarily current.
+BUFFER-OR-NAME must be a buffer or the name of an existing buffer.
+The value returned is the value of the last form in BODY. See
+also `with-temp-buffer'."
(declare (indent 1) (debug t))
`(save-current-buffer
- (set-buffer ,buffer)
+ (set-buffer ,buffer-or-name)
,@body))
(defmacro with-selected-window (window &rest body)
"Execute the forms in BODY with WINDOW as the selected window.
The value returned is the value of the last form in BODY.
-This macro saves and restores the current buffer, since otherwise
-its normal operation could potentially make a different
-buffer current. It does not alter the buffer list ordering.
-
-This macro saves and restores the selected window, as well as
-the selected window in each frame. If the previously selected
-window of some frame is no longer live at the end of BODY, that
-frame's selected window is left alone. If the selected window is
-no longer live, then whatever window is selected at the end of
-BODY remains selected.
-See also `with-temp-buffer'."
+This macro saves and restores the selected window, as well as the
+selected window of each frame. It does not change the order of
+recently selected windows. If the previously selected window of
+some frame is no longer live at the end of BODY, that frame's
+selected window is left alone. If the selected window is no
+longer live, then whatever window is selected at the end of BODY
+remains selected.
+
+This macro uses `save-current-buffer' to save and restore the
+current buffer, since otherwise its normal operation could
+potentially make a different buffer current. It does not alter
+the buffer list ordering."
(declare (indent 1) (debug t))
;; Most of this code is a copy of save-selected-window.
`(let ((save-selected-window-window (selected-window))
(dolist (elt save-selected-window-alist)
(and (frame-live-p (car elt))
(window-live-p (cadr elt))
- (set-frame-selected-window (car elt) (cadr elt))))
- (if (window-live-p save-selected-window-window)
- (select-window save-selected-window-window 'norecord))))))
+ (set-frame-selected-window (car elt) (cadr elt) 'norecord)))
+ (when (window-live-p save-selected-window-window)
+ (select-window save-selected-window-window 'norecord))))))
(defmacro with-selected-frame (frame &rest body)
"Execute the forms in BODY with FRAME as the selected frame.
The value returned is the value of the last form in BODY.
-See also `with-temp-buffer'."
+
+This macro neither changes the order of recently selected windows
+nor the buffer list."
(declare (indent 1) (debug t))
(let ((old-frame (make-symbol "old-frame"))
(old-buffer (make-symbol "old-buffer")))
`(let ((,old-frame (selected-frame))
(,old-buffer (current-buffer)))
(unwind-protect
- (progn (select-frame ,frame)
+ (progn (select-frame ,frame 'norecord)
,@body)
- (if (frame-live-p ,old-frame)
- (select-frame ,old-frame))
- (if (buffer-live-p ,old-buffer)
- (set-buffer ,old-buffer))))))
+ (when (frame-live-p ,old-frame)
+ (select-frame ,old-frame 'norecord))
+ (when (buffer-live-p ,old-buffer)
+ (set-buffer ,old-buffer))))))
(defmacro with-temp-file (file &rest body)
"Create a new buffer, evaluate BODY there, and write the buffer to FILE.
starting position, to avoid checking matches that would start
before LIMIT.
-If GREEDY is non-nil, extend the match backwards as far as possible,
-stopping when a single additional previous character cannot be part
-of a match for REGEXP."
+If GREEDY is non-nil, extend the match backwards as far as
+possible, stopping when a single additional previous character
+cannot be part of a match for REGEXP. When the match is
+extended, its starting position is allowed to occur before
+LIMIT."
(let ((start (point))
(pos
(save-excursion
(split-string-and-unquote (combine-and-quote-strings strs)) == strs
The SEPARATOR regexp defaults to \"\\s-+\"."
(let ((sep (or separator "\\s-+"))
- (i (string-match "[\"]" string)))
+ (i (string-match "\"" string)))
(if (null i)
(split-string string sep t) ; no quoting: easy
(append (unless (eq i 0) (split-string (substring string 0 i) sep t))
\"1alpha\"."
(version-list-= (version-to-list v1) (version-to-list v2)))
-
-
;; arch-tag: f7e0e6e5-70aa-4897-ae72-7a3511ec40bc
;;; subr.el ends here
HCoop / bpt / emacs.git / blobdiff