;;; subr.el --- basic lisp subroutines for Emacs
;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
(setq custom-declare-variable-list
(cons arguments custom-declare-variable-list)))
+(defmacro declare-function (fn file &optional arglist fileonly)
+ "Tell the byte-compiler that function FN is defined, in FILE.
+Optional ARGLIST is the argument list used by the function. The
+FILE argument is not used by the byte-compiler, but by the
+`check-declare' package, which checks that FILE contains a
+definition for FN. ARGLIST is used by both the byte-compiler and
+`check-declare' to check for consistency.
+
+FILE can be either a Lisp file (in which case the \".el\"
+extension is optional), or a C file. C files are expanded
+relative to the Emacs \"src/\" directory. Lisp files are
+searched for using `locate-library', and if that fails they are
+expanded relative to the location of the file containing the
+declaration. A FILE with an \"ext:\" prefix is an external file.
+`check-declare' will check such files if they are found, and skip
+them without error if they are not.
+
+FILEONLY non-nil means that `check-declare' will only check that
+FILE exists, not that it defines FN. This is intended for
+function-definitions that `check-declare' does not recognize, e.g.
+`defstruct'.
+
+To specify a value for FILEONLY without passing an argument list,
+set ARGLIST to `t'. This is necessary because `nil' means an
+empty argument list, rather than an unspecified one.
+
+Note that for the purposes of `check-declare', this statement
+must be the first non-whitespace on a line, and everything up to
+the end of FILE must be all on the same line. For example:
+
+\(declare-function c-end-of-defun \"progmodes/cc-cmds.el\"
+ \(&optional arg))
+
+For more information, see Info node `elisp(Declaring Functions)'."
+ ;; Does nothing - byte-compile-declare-function does the work.
+ nil)
\f
;;;; Basic Lisp macros.
(setq inserted t)))
(setq tail (cdr tail)))))
-(defun map-keymap-internal (function keymap &optional sort-first)
+(defun map-keymap-sorted (function keymap)
"Implement `map-keymap' with sorting.
Don't call this function; it is for internal use only."
- (if sort-first
- (let (list)
- (map-keymap (lambda (a b) (push (cons a b) list))
- keymap)
- (setq list (sort list
- (lambda (a b)
- (setq a (car a) b (car b))
- (if (integerp a)
- (if (integerp b) (< a b)
- t)
- (if (integerp b) t
- ;; string< also accepts symbols.
- (string< a b))))))
- (dolist (p list)
- (funcall function (car p) (cdr p))))
- (map-keymap function keymap)))
+ (let (list)
+ (map-keymap (lambda (a b) (push (cons a b) list))
+ keymap)
+ (setq list (sort list
+ (lambda (a b)
+ (setq a (car a) b (car b))
+ (if (integerp a)
+ (if (integerp b) (< a b)
+ t)
+ (if (integerp b) t
+ ;; string< also accepts symbols.
+ (string< a b))))))
+ (dolist (p list)
+ (funcall function (car p) (cdr p)))))
(put 'keyboard-translate-table 'char-table-extra-slots 0)
(if (listp type)
(setq type (car type)))
(if (symbolp type)
- (cdr (get type 'event-symbol-elements))
+ ;; Don't read event-symbol-elements directly since we're not
+ ;; sure the symbol has already been parsed.
+ (cdr (internal-event-symbol-parse-modifiers type))
(let ((list nil)
(char (logand type (lognot (logior ?\M-\^@ ?\C-\^@ ?\S-\^@
?\H-\^@ ?\s-\^@ ?\A-\^@)))))
(x (/ (car pair) (frame-char-width frame)))
(y (/ (cdr pair) (+ (frame-char-height frame)
(or (frame-parameter frame 'line-spacing)
- default-line-spacing
+ ;; FIXME: Why the `default'?
+ (default-value 'line-spacing)
0)))))
(cons x y))))))
(make-obsolete 'focus-frame "it does nothing." "22.1")
(defalias 'unfocus-frame 'ignore "")
(make-obsolete 'unfocus-frame "it does nothing." "22.1")
-(make-obsolete 'make-variable-frame-local "use a frame-parameter instead" "22.2")
+(make-obsolete 'make-variable-frame-local "use a frame-parameter instead." "22.2")
\f
;;;; Obsolescence declarations for variables, and aliases.
+(make-obsolete-variable 'redisplay-end-trigger-functions 'jit-lock-register "23.1")
+(make-obsolete 'window-redisplay-end-trigger nil "23.1")
+(make-obsolete 'set-window-redisplay-end-trigger nil "23.1")
+
+(make-obsolete 'process-filter-multibyte-p nil "23.1")
+(make-obsolete 'set-process-filter-multibyte nil "23.1")
+
(make-obsolete-variable 'directory-sep-char "do not use it." "21.1")
(make-obsolete-variable
'mode-line-inverse-video
(append hook-value (list function))
(cons function hook-value))))
;; Set the actual variable
- (if local (set hook hook-value) (set-default hook hook-value))))
+ (if local
+ (progn
+ ;; If HOOK isn't a permanent local,
+ ;; but FUNCTION wants to survive a change of modes,
+ ;; mark HOOK as partially permanent.
+ (and (symbolp function)
+ (get function 'permanent-local-hook)
+ (not (get hook 'permanent-local))
+ (put hook 'permanent-local 'permanent-local-hook))
+ (set hook hook-value))
+ (set-default hook hook-value))))
(defun remove-hook (hook function &optional local)
"Remove from the value of HOOK the function FUNCTION.
(setq files (cdr files)))
file)))
-;;;###autoload
(defun locate-library (library &optional nosuffix path interactive-call)
"Show the precise file name of Emacs library LIBRARY.
This command searches the directories in `load-path' like `\\[load-library]'
\f
;;;; Process stuff.
+(defun process-lines (program &rest args)
+ "Execute PROGRAM with ARGS, returning its output as a list of lines.
+Signal an error if the program returns with a non-zero exit status."
+ (with-temp-buffer
+ (let ((status (apply 'call-process program nil (current-buffer) nil args)))
+ (unless (eq status 0)
+ (error "%s exited with status %s" program status))
+ (goto-char (point-min))
+ (let (lines)
+ (while (not (eobp))
+ (setq lines (cons (buffer-substring-no-properties
+ (line-beginning-position)
+ (line-end-position))
+ lines))
+ (forward-line 1))
+ (nreverse lines)))))
+
;; open-network-stream is a wrapper around make-network-process.
(when (featurep 'make-network-process)
;; We could try and use read-key-sequence instead, but then C-q ESC
;; or C-q C-x might not return immediately since ESC or C-x might be
;; bound to some prefix in function-key-map or key-translation-map.
- (setq translated char)
+ (setq translated
+ (if (integerp char)
+ (char-resolve-modifers char)
+ char))
(let ((translation (lookup-key local-function-key-map (vector char))))
(if (arrayp translation)
(setq translated (aref translation 0))))
floating point support.
\(fn SECONDS &optional NODISP)"
- (when (or obsolete (numberp nodisp))
- (setq seconds (+ seconds (* 1e-3 nodisp)))
- (setq nodisp obsolete))
+ (if (numberp nodisp)
+ (setq seconds (+ seconds (* 1e-3 nodisp))
+ nodisp obsolete)
+ (if obsolete (setq nodisp obsolete)))
(cond
(noninteractive
(sleep-for seconds)
(let ((handle (make-symbol "--change-group-handle--"))
(success (make-symbol "--change-group-success--")))
`(let ((,handle (prepare-change-group))
+ ;; Don't truncate any undo data in the middle of this.
+ (undo-outer-limit nil)
+ (undo-limit most-positive-fixnum)
+ (undo-strong-limit most-positive-fixnum)
(,success nil))
(unwind-protect
(progn
(with-current-buffer (car elt)
(setq elt (cdr elt))
(let ((old-car
- (if (consp elt) (car elt)))
- (old-cdr
- (if (consp elt) (cdr elt))))
- ;; Temporarily truncate the undo log at ELT.
- (when (consp elt)
- (setcar elt nil) (setcdr elt nil))
- (unless (eq last-command 'undo) (undo-start))
- ;; Make sure there's no confusion.
- (when (and (consp elt) (not (eq elt (last pending-undo-list))))
- (error "Undoing to some unrelated state"))
- ;; Undo it all.
- (while (listp pending-undo-list) (undo-more 1))
- ;; Reset the modified cons cell ELT to its original content.
- (when (consp elt)
- (setcar elt old-car)
- (setcdr elt old-cdr))
- ;; Revert the undo info to what it was when we grabbed the state.
- (setq buffer-undo-list elt)))))
+ (if (consp elt) (car elt)))
+ (old-cdr
+ (if (consp elt) (cdr elt))))
+ ;; Temporarily truncate the undo log at ELT.
+ (when (consp elt)
+ (setcar elt nil) (setcdr elt nil))
+ (unless (eq last-command 'undo) (undo-start))
+ ;; Make sure there's no confusion.
+ (when (and (consp elt) (not (eq elt (last pending-undo-list))))
+ (error "Undoing to some unrelated state"))
+ ;; Undo it all.
+ (save-excursion
+ (while (listp pending-undo-list) (undo-more 1)))
+ ;; Reset the modified cons cell ELT to its original content.
+ (when (consp elt)
+ (setcar elt old-car)
+ (setcdr elt old-cdr))
+ ;; Revert the undo info to what it was when we grabbed the state.
+ (setq buffer-undo-list elt)))))
\f
;;;; Display-related functions.
(defun find-tag-default ()
"Determine default tag to search for, based on text at point.
If there is no plausible default, return nil."
- (save-excursion
- (while (looking-at "\\sw\\|\\s_")
- (forward-char 1))
- (if (or (re-search-backward "\\sw\\|\\s_"
- (save-excursion (beginning-of-line) (point))
- t)
- (re-search-forward "\\(\\sw\\|\\s_\\)+"
- (save-excursion (end-of-line) (point))
- t))
- (progn
- (goto-char (match-end 0))
- (condition-case nil
- (buffer-substring-no-properties
- (point)
- (progn (forward-sexp -1)
- (while (looking-at "\\s'")
- (forward-char 1))
- (point)))
- (error nil)))
- nil)))
+ (let (from to bound)
+ (when (or (progn
+ ;; Look at text around `point'.
+ (save-excursion
+ (skip-syntax-backward "w_") (setq from (point)))
+ (save-excursion
+ (skip-syntax-forward "w_") (setq to (point)))
+ (> to from))
+ ;; Look between `line-beginning-position' and `point'.
+ (save-excursion
+ (and (setq bound (line-beginning-position))
+ (skip-syntax-backward "^w_" bound)
+ (> (setq to (point)) bound)
+ (skip-syntax-backward "w_")
+ (setq from (point))))
+ ;; Look between `point' and `line-end-position'.
+ (save-excursion
+ (and (setq bound (line-end-position))
+ (skip-syntax-forward "^w_" bound)
+ (< (setq from (point)) bound)
+ (skip-syntax-forward "w_")
+ (setq to (point)))))
+ (buffer-substring-no-properties from to))))
(defun play-sound (sound)
"SOUND is a list of the form `(sound KEYWORD VALUE...)'.
(play-sound-internal sound)
(error "This Emacs binary lacks sound support")))
+(declare-function w32-shell-dos-semantics "w32-fns" nil)
+
(defun shell-quote-argument (argument)
"Quote an argument for passing as argument to an inferior shell."
(if (or (eq system-type 'ms-dos)
(catch ',catch-sym
(let ((throw-on-input ',catch-sym))
(or (input-pending-p)
- ,@body))))))
+ (progn ,@body)))))))
(defmacro condition-case-no-debug (var bodyform &rest handlers)
"Like `condition-case' except that it does not catch anything when debugging.
HCoop / bpt / emacs.git / blobdiff