+++ /dev/null
-;;; byte-run.el --- byte-compiler support for inlining
-
-;; Copyright (C) 1992 Free Software Foundation, Inc.
-
-;; Author: Jamie Zawinski <jwz@lucid.com>
-;; Hallvard Furuseth <hbf@ulrik.uio.no>
-;; Maintainer: FSF
-;; Keywords: internal
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; interface to selectively inlining functions.
-;; This only happens when source-code optimization is turned on.
-
-;;; Code:
-
-;; Redefined in byte-optimize.el.
-;; This is not documented--it's not clear that we should promote it.
-(fset 'inline 'progn)
-(put 'inline 'lisp-indent-hook 0)
-
-
-;;; Interface to inline functions.
-
-;; (defmacro proclaim-inline (&rest fns)
-;; "Cause the named functions to be open-coded when called from compiled code.
-;; They will only be compiled open-coded when byte-compile-optimize is true."
-;; (cons 'eval-and-compile
-;; (mapcar '(lambda (x)
-;; (or (memq (get x 'byte-optimizer)
-;; '(nil byte-compile-inline-expand))
-;; (error
-;; "%s already has a byte-optimizer, can't make it inline"
-;; x))
-;; (list 'put (list 'quote x)
-;; ''byte-optimizer ''byte-compile-inline-expand))
-;; fns)))
-
-;; (defmacro proclaim-notinline (&rest fns)
-;; "Cause the named functions to no longer be open-coded."
-;; (cons 'eval-and-compile
-;; (mapcar '(lambda (x)
-;; (if (eq (get x 'byte-optimizer) 'byte-compile-inline-expand)
-;; (put x 'byte-optimizer nil))
-;; (list 'if (list 'eq (list 'get (list 'quote x) ''byte-optimizer)
-;; ''byte-compile-inline-expand)
-;; (list 'put x ''byte-optimizer nil)))
-;; fns)))
-
-;; This has a special byte-hunk-handler in bytecomp.el.
-(defmacro defsubst (name arglist &rest body)
- "Define an inline function. The syntax is just like that of `defun'."
- (or (memq (get name 'byte-optimizer)
- '(nil byte-compile-inline-expand))
- (error "`%s' is a primitive" name))
- (list 'prog1
- (cons 'defun (cons name (cons arglist body)))
- (list 'eval-and-compile
- (list 'put (list 'quote name)
- ''byte-optimizer ''byte-compile-inline-expand))))
-
-(defun make-obsolete (fn new &optional when)
- "Make the byte-compiler warn that FUNCTION is obsolete.
-The warning will say that NEW should be used instead.
-If NEW is a string, that is the `use instead' message.
-If provided, WHEN should be a string indicating when the function
-was first made obsolete, for example a date or a release number."
- (interactive "aMake function obsolete: \nxObsoletion replacement: ")
- (let ((handler (get fn 'byte-compile)))
- (if (eq 'byte-compile-obsolete handler)
- (setq handler (nth 1 (get fn 'byte-obsolete-info)))
- (put fn 'byte-compile 'byte-compile-obsolete))
- (put fn 'byte-obsolete-info (list new handler when)))
- fn)
-
-(defun make-obsolete-variable (var new &optional when)
- "Make the byte-compiler warn that VARIABLE is obsolete,
-and NEW should be used instead. If NEW is a string, then that is the
-`use instead' message.
-If provided, WHEN should be a string indicating when the variable
-was first made obsolete, for example a date or a release number."
- (interactive
- (list
- (let ((str (completing-read "Make variable obsolete: " obarray 'boundp t)))
- (if (equal str "") (error ""))
- (intern str))
- (car (read-from-string (read-string "Obsoletion replacement: ")))))
- (put var 'byte-obsolete-variable (cons new when))
- var)
-
-(put 'dont-compile 'lisp-indent-hook 0)
-(defmacro dont-compile (&rest body)
- "Like `progn', but the body always runs interpreted (not compiled).
-If you think you need this, you're probably making a mistake somewhere."
- (list 'eval (list 'quote (if (cdr body) (cons 'progn body) (car body)))))
-
-\f
-;;; interface to evaluating things at compile time and/or load time
-;;; these macro must come after any uses of them in this file, as their
-;;; definition in the file overrides the magic definitions on the
-;;; byte-compile-macro-environment.
-
-(put 'eval-when-compile 'lisp-indent-hook 0)
-(defmacro eval-when-compile (&rest body)
- "Like `progn', but evaluates the body at compile time.
-The result of the body appears to the compiler as a quoted constant."
- ;; Not necessary because we have it in b-c-initial-macro-environment
- ;; (list 'quote (eval (cons 'progn body)))
- (cons 'progn body))
-
-(put 'eval-and-compile 'lisp-indent-hook 0)
-(defmacro eval-and-compile (&rest body)
- "Like `progn', but evaluates the body at compile time and at load time."
- ;; Remember, it's magic.
- (cons 'progn body))
-
-(defun with-no-warnings (&optional first &rest body)
- "Like `progn', but prevents compiler warnings in the body."
- ;; The implementation for the interpreter is basically trivial.
- (if body (car (last body))
- first))
-
-\f
-;;; I nuked this because it's not a good idea for users to think of using it.
-;;; These options are a matter of installation preference, and have nothing to
-;;; with particular source files; it's a mistake to suggest to users
-;;; they should associate these with particular source files.
-;;; There is hardly any reason to change these parameters, anyway.
-;;; --rms.
-
-;; (put 'byte-compiler-options 'lisp-indent-hook 0)
-;; (defmacro byte-compiler-options (&rest args)
-;; "Set some compilation-parameters for this file. This will affect only the
-;; file in which it appears; this does nothing when evaluated, and when loaded
-;; from a .el file.
-;;
-;; Each argument to this macro must be a list of a key and a value.
-;;
-;; Keys: Values: Corresponding variable:
-;;
-;; verbose t, nil byte-compile-verbose
-;; optimize t, nil, source, byte byte-compile-optimize
-;; warnings list of warnings byte-compile-warnings
-;; Legal elements: (callargs redefine free-vars unresolved)
-;; file-format emacs18, emacs19 byte-compile-compatibility
-;;
-;; For example, this might appear at the top of a source file:
-;;
-;; (byte-compiler-options
-;; (optimize t)
-;; (warnings (- free-vars)) ; Don't warn about free variables
-;; (file-format emacs19))"
-;; nil)
-
-;;; byte-run.el ends here
+++ /dev/null
-;;; derived.el --- allow inheritance of major modes
-;;; (formerly mode-clone.el)
-
-;; Copyright (C) 1993, 1994, 1999, 2003 Free Software Foundation, Inc.
-
-;; Author: David Megginson (dmeggins@aix1.uottawa.ca)
-;; Maintainer: FSF
-;; Keywords: extensions
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-\f
-;;; Commentary:
-
-;; GNU Emacs is already, in a sense, object oriented -- each object
-;; (buffer) belongs to a class (major mode), and that class defines
-;; the relationship between messages (input events) and methods
-;; (commands) by means of a keymap.
-;;
-;; The only thing missing is a good scheme of inheritance. It is
-;; possible to simulate a single level of inheritance with generous
-;; use of hooks and a bit of work -- sgml-mode, for example, also runs
-;; the hooks for text-mode, and keymaps can inherit from other keymaps
-;; -- but generally, each major mode ends up reinventing the wheel.
-;; Ideally, someone should redesign all of Emacs's major modes to
-;; follow a more conventional object-oriented system: when defining a
-;; new major mode, the user should need only to name the existing mode
-;; it is most similar to, then list the (few) differences.
-;;
-;; In the mean time, this package offers most of the advantages of
-;; full inheritance with the existing major modes. The macro
-;; `define-derived-mode' allows the user to make a variant of an existing
-;; major mode, with its own keymap. The new mode will inherit the key
-;; bindings of its parent, and will, in fact, run its parent first
-;; every time it is called. For example, the commands
-;;
-;; (define-derived-mode hypertext-mode text-mode "Hypertext"
-;; "Major mode for hypertext.\n\n\\{hypertext-mode-map}"
-;; (setq case-fold-search nil))
-;;
-;; (define-key hypertext-mode-map [down-mouse-3] 'do-hyper-link)
-;;
-;; will create a function `hypertext-mode' with its own (sparse)
-;; keymap `hypertext-mode-map.' The command M-x hypertext-mode will
-;; perform the following actions:
-;;
-;; - run the command (text-mode) to get its default setup
-;; - replace the current keymap with 'hypertext-mode-map,' which will
-;; inherit from 'text-mode-map'.
-;; - replace the current syntax table with
-;; 'hypertext-mode-syntax-table', which will borrow its defaults
-;; from the current text-mode-syntax-table.
-;; - replace the current abbrev table with
-;; 'hypertext-mode-abbrev-table', which will borrow its defaults
-;; from the current text-mode-abbrev table
-;; - change the mode line to read "Hypertext"
-;; - assign the value 'hypertext-mode' to the 'major-mode' variable
-;; - run the body of commands provided in the macro -- in this case,
-;; set the local variable `case-fold-search' to nil.
-;;
-;; The advantages of this system are threefold. First, text mode is
-;; untouched -- if you had added the new keystroke to `text-mode-map,'
-;; possibly using hooks, you would have added it to all text buffers
-;; -- here, it appears only in hypertext buffers, where it makes
-;; sense. Second, it is possible to build even further, and make
-;; a derived mode from a derived mode. The commands
-;;
-;; (define-derived-mode html-mode hypertext-mode "HTML")
-;; [various key definitions]
-;;
-;; will add a new major mode for HTML with very little fuss.
-;;
-;; Note also the function `derived-mode-p' which can tell if the current
-;; mode derives from another. In a hypertext-mode, buffer, for example,
-;; (derived-mode-p 'text-mode) would return non-nil. This should always
-;; be used in place of (eq major-mode 'text-mode).
-\f
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-;;; PRIVATE: defsubst must be defined before they are first used
-
-(defsubst derived-mode-hook-name (mode)
- "Construct the mode hook name based on mode name MODE."
- (intern (concat (symbol-name mode) "-hook")))
-
-(defsubst derived-mode-map-name (mode)
- "Construct a map name based on a MODE name."
- (intern (concat (symbol-name mode) "-map")))
-
-(defsubst derived-mode-syntax-table-name (mode)
- "Construct a syntax-table name based on a MODE name."
- (intern (concat (symbol-name mode) "-syntax-table")))
-
-(defsubst derived-mode-abbrev-table-name (mode)
- "Construct an abbrev-table name based on a MODE name."
- (intern (concat (symbol-name mode) "-abbrev-table")))
-
-;; PUBLIC: define a new major mode which inherits from an existing one.
-
-;;;###autoload
-(defmacro define-derived-mode (child parent name &optional docstring &rest body)
- "Create a new mode as a variant of an existing mode.
-
-The arguments to this command are as follow:
-
-CHILD: the name of the command for the derived mode.
-PARENT: the name of the command for the parent mode (e.g. `text-mode')
- or nil if there is no parent.
-NAME: a string which will appear in the status line (e.g. \"Hypertext\")
-DOCSTRING: an optional documentation string--if you do not supply one,
- the function will attempt to invent something useful.
-BODY: forms to execute just before running the
- hooks for the new mode. Do not use `interactive' here.
-
-BODY can start with a bunch of keyword arguments. The following keyword
- arguments are currently understood:
-:group GROUP
- Declare the customization group that corresponds to this mode.
-:syntax-table TABLE
- Use TABLE instead of the default.
- A nil value means to simply use the same syntax-table as the parent.
-:abbrev-table TABLE
- Use TABLE instead of the default.
- A nil value means to simply use the same abbrev-table as the parent.
-
-Here is how you could define LaTeX-Thesis mode as a variant of LaTeX mode:
-
- (define-derived-mode LaTeX-thesis-mode LaTeX-mode \"LaTeX-Thesis\")
-
-You could then make new key bindings for `LaTeX-thesis-mode-map'
-without changing regular LaTeX mode. In this example, BODY is empty,
-and DOCSTRING is generated by default.
-
-On a more complicated level, the following command uses `sgml-mode' as
-the parent, and then sets the variable `case-fold-search' to nil:
-
- (define-derived-mode article-mode sgml-mode \"Article\"
- \"Major mode for editing technical articles.\"
- (setq case-fold-search nil))
-
-Note that if the documentation string had been left out, it would have
-been generated automatically, with a reference to the keymap."
- (declare (debug (&define name symbolp sexp [&optional stringp]
- [&rest keywordp sexp] def-body)))
-
- (when (and docstring (not (stringp docstring)))
- ;; Some trickiness, since what appears to be the docstring may really be
- ;; the first element of the body.
- (push docstring body)
- (setq docstring nil))
-
- (when (eq parent 'fundamental-mode) (setq parent nil))
-
- (let ((map (derived-mode-map-name child))
- (syntax (derived-mode-syntax-table-name child))
- (abbrev (derived-mode-abbrev-table-name child))
- (declare-abbrev t)
- (declare-syntax t)
- (hook (derived-mode-hook-name child))
- (group nil))
-
- ;; Process the keyword args.
- (while (keywordp (car body))
- (case (pop body)
- (:group (setq group (pop body)))
- (:abbrev-table (setq abbrev (pop body)) (setq declare-abbrev nil))
- (:syntax-table (setq syntax (pop body)) (setq declare-syntax nil))
- (t (pop body))))
-
- (setq docstring (derived-mode-make-docstring
- parent child docstring syntax abbrev))
-
- `(progn
- (defvar ,map (make-sparse-keymap))
- ,(if declare-syntax
- `(defvar ,syntax (make-syntax-table)))
- ,(if declare-abbrev
- `(defvar ,abbrev
- (progn (define-abbrev-table ',abbrev nil) ,abbrev)))
- (put ',child 'derived-mode-parent ',parent)
- ,(if group `(put ',child 'custom-mode-group ,group))
-
- (defun ,child ()
- ,docstring
- (interactive)
- ; Run the parent.
- (delay-mode-hooks
-
- (,(or parent 'kill-all-local-variables))
- ; Identify the child mode.
- (setq major-mode (quote ,child))
- (setq mode-name ,name)
- ; Identify special modes.
- ,(when parent
- `(progn
- (if (get (quote ,parent) 'mode-class)
- (put (quote ,child) 'mode-class
- (get (quote ,parent) 'mode-class)))
- ; Set up maps and tables.
- (unless (keymap-parent ,map)
- (set-keymap-parent ,map (current-local-map)))
- ,(when declare-syntax
- `(let ((parent (char-table-parent ,syntax)))
- (unless (and parent
- (not (eq parent (standard-syntax-table))))
- (set-char-table-parent ,syntax (syntax-table)))))))
-
- (use-local-map ,map)
- ,(when syntax `(set-syntax-table ,syntax))
- ,(when abbrev `(setq local-abbrev-table ,abbrev))
- ; Splice in the body (if any).
- ,@body
- )
- ;; Run the hooks, if any.
- ;; Make the generated code work in older Emacs versions
- ;; that do not yet have run-mode-hooks.
- (if (fboundp 'run-mode-hooks)
- (run-mode-hooks ',hook)
- (run-hooks ',hook))))))
-
-;; PUBLIC: find the ultimate class of a derived mode.
-
-(defun derived-mode-class (mode)
- "Find the class of a major MODE.
-A mode's class is the first ancestor which is NOT a derived mode.
-Use the `derived-mode-parent' property of the symbol to trace backwards.
-Since major-modes might all derive from `fundamental-mode', this function
-is not very useful."
- (while (get mode 'derived-mode-parent)
- (setq mode (get mode 'derived-mode-parent)))
- mode)
-(make-obsolete 'derived-mode-class 'derived-mode-p "21.4")
-
-\f
-;;; PRIVATE
-
-(defun derived-mode-make-docstring (parent child &optional
- docstring syntax abbrev)
- "Construct a docstring for a new mode if none is provided."
-
- (let ((map (derived-mode-map-name child))
- (hook (derived-mode-hook-name child)))
-
- (unless (stringp docstring)
- ;; Use a default docstring.
- (setq docstring
- (if (null parent)
- (format "Major-mode.
-Uses keymap `%s', abbrev table `%s' and syntax-table `%s'." map abbrev syntax)
- (format "Major mode derived from `%s' by `define-derived-mode'.
-It inherits all of the parent's attributes, but has its own keymap,
-abbrev table and syntax table:
-
- `%s', `%s' and `%s'
-
-which more-or-less shadow %s's corresponding tables."
- parent map abbrev syntax parent))))
-
- (unless (string-match (regexp-quote (symbol-name hook)) docstring)
- ;; Make sure the docstring mentions the mode's hook.
- (setq docstring
- (concat docstring
- (if (null parent)
- "\n\nThis mode "
- (concat
- "\n\nIn addition to any hooks its parent mode "
- (if (string-match (regexp-quote (format "`%s'" parent))
- docstring) nil
- (format "`%s' " parent))
- "might have run,\nthis mode "))
- (format "runs the hook `%s'" hook)
- ", as the final step\nduring initialization.")))
-
- (unless (string-match "\\\\[{[]" docstring)
- ;; And don't forget to put the mode's keymap.
- (setq docstring (concat docstring "\n\n\\{" (symbol-name map) "}")))
-
- docstring))
-
-\f
-;;; OBSOLETE
-;; The functions below are only provided for backward compatibility with
-;; code byte-compiled with versions of derived.el prior to Emacs-21.
-
-(defsubst derived-mode-setup-function-name (mode)
- "Construct a setup-function name based on a MODE name."
- (intern (concat (symbol-name mode) "-setup")))
-
-\f
-;; Utility functions for defining a derived mode.
-
-;;;###autoload
-(defun derived-mode-init-mode-variables (mode)
- "Initialise variables for a new MODE.
-Right now, if they don't already exist, set up a blank keymap, an
-empty syntax table, and an empty abbrev table -- these will be merged
-the first time the mode is used."
-
- (if (boundp (derived-mode-map-name mode))
- t
- (eval `(defvar ,(derived-mode-map-name mode)
- (make-sparse-keymap)
- ,(format "Keymap for %s." mode)))
- (put (derived-mode-map-name mode) 'derived-mode-unmerged t))
-
- (if (boundp (derived-mode-syntax-table-name mode))
- t
- (eval `(defvar ,(derived-mode-syntax-table-name mode)
- ;; Make a syntax table which doesn't specify anything
- ;; for any char. Valid data will be merged in by
- ;; derived-mode-merge-syntax-tables.
- (make-char-table 'syntax-table nil)
- ,(format "Syntax table for %s." mode)))
- (put (derived-mode-syntax-table-name mode) 'derived-mode-unmerged t))
-
- (if (boundp (derived-mode-abbrev-table-name mode))
- t
- (eval `(defvar ,(derived-mode-abbrev-table-name mode)
- (progn
- (define-abbrev-table (derived-mode-abbrev-table-name mode) nil)
- (make-abbrev-table))
- ,(format "Abbrev table for %s." mode)))))
-\f
-;; Utility functions for running a derived mode.
-
-(defun derived-mode-set-keymap (mode)
- "Set the keymap of the new MODE, maybe merging with the parent."
- (let* ((map-name (derived-mode-map-name mode))
- (new-map (eval map-name))
- (old-map (current-local-map)))
- (and old-map
- (get map-name 'derived-mode-unmerged)
- (derived-mode-merge-keymaps old-map new-map))
- (put map-name 'derived-mode-unmerged nil)
- (use-local-map new-map)))
-
-(defun derived-mode-set-syntax-table (mode)
- "Set the syntax table of the new MODE, maybe merging with the parent."
- (let* ((table-name (derived-mode-syntax-table-name mode))
- (old-table (syntax-table))
- (new-table (eval table-name)))
- (if (get table-name 'derived-mode-unmerged)
- (derived-mode-merge-syntax-tables old-table new-table))
- (put table-name 'derived-mode-unmerged nil)
- (set-syntax-table new-table)))
-
-(defun derived-mode-set-abbrev-table (mode)
- "Set the abbrev table for MODE if it exists.
-Always merge its parent into it, since the merge is non-destructive."
- (let* ((table-name (derived-mode-abbrev-table-name mode))
- (old-table local-abbrev-table)
- (new-table (eval table-name)))
- (derived-mode-merge-abbrev-tables old-table new-table)
- (setq local-abbrev-table new-table)))
-
-;;;(defun derived-mode-run-setup-function (mode)
-;;; "Run the setup function if it exists."
-
-;;; (let ((fname (derived-mode-setup-function-name mode)))
-;;; (if (fboundp fname)
-;;; (funcall fname))))
-
-(defun derived-mode-run-hooks (mode)
- "Run the mode hook for MODE."
- (let ((hooks-name (derived-mode-hook-name mode)))
- (if (boundp hooks-name)
- (run-hooks hooks-name))))
-
-;; Functions to merge maps and tables.
-
-(defun derived-mode-merge-keymaps (old new)
- "Merge an OLD keymap into a NEW one.
-The old keymap is set to be the last cdr of the new one, so that there will
-be automatic inheritance."
- ;; ?? Can this just use `set-keymap-parent'?
- (let ((tail new))
- ;; Scan the NEW map for prefix keys.
- (while (consp tail)
- (and (consp (car tail))
- (let* ((key (vector (car (car tail))))
- (subnew (lookup-key new key))
- (subold (lookup-key old key)))
- ;; If KEY is a prefix key in both OLD and NEW, merge them.
- (and (keymapp subnew) (keymapp subold)
- (derived-mode-merge-keymaps subold subnew))))
- (and (vectorp (car tail))
- ;; Search a vector of ASCII char bindings for prefix keys.
- (let ((i (1- (length (car tail)))))
- (while (>= i 0)
- (let* ((key (vector i))
- (subnew (lookup-key new key))
- (subold (lookup-key old key)))
- ;; If KEY is a prefix key in both OLD and NEW, merge them.
- (and (keymapp subnew) (keymapp subold)
- (derived-mode-merge-keymaps subold subnew)))
- (setq i (1- i)))))
- (setq tail (cdr tail))))
- (setcdr (nthcdr (1- (length new)) new) old))
-
-(defun derived-mode-merge-syntax-tables (old new)
- "Merge an OLD syntax table into a NEW one.
-Where the new table already has an entry, nothing is copied from the old one."
- (set-char-table-parent new old))
-
-;; Merge an old abbrev table into a new one.
-;; This function requires internal knowledge of how abbrev tables work,
-;; presuming that they are obarrays with the abbrev as the symbol, the expansion
-;; as the value of the symbol, and the hook as the function definition.
-(defun derived-mode-merge-abbrev-tables (old new)
- (if old
- (mapatoms
- (lambda (symbol)
- (or (intern-soft (symbol-name symbol) new)
- (define-abbrev new (symbol-name symbol)
- (symbol-value symbol) (symbol-function symbol))))
- old)))
-
-(provide 'derived)
-
-;;; derived.el ends here
+++ /dev/null
-;;; float-sup.el --- define some constants useful for floating point numbers.
-
-;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: internal
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-;; Provide a meaningful error message if we are running on
-;; bare (non-float) emacs.
-
-(if (fboundp 'atan)
- nil
- (error "Floating point was disabled at compile time"))
-
-;; provide an easy hook to tell if we are running with floats or not.
-;; define pi and e via math-lib calls. (much less prone to killer typos.)
-(defconst pi (* 4 (atan 1)) "The value of Pi (3.1415926...).")
-;; It's too inconvenient to make `e' a constant because it's used as
-;; a temporary variable all the time.
-(defvar e (exp 1) "The value of e (2.7182818...).")
-
-;; Careful when editing this file ... typos here will be hard to spot.
-;; (defconst pi 3.14159265358979323846264338327
-;; "The value of Pi (3.14159265358979323846264338327...)")
-
-(defconst degrees-to-radians (/ pi 180.0)
- "Degrees to radian conversion constant.")
-(defconst radians-to-degrees (/ 180.0 pi)
- "Radian to degree conversion constant.")
-
-;; these expand to a single multiply by a float when byte compiled
-
-(defmacro degrees-to-radians (x)
- "Convert ARG from degrees to radians."
- (list '* (/ pi 180.0) x))
-(defmacro radians-to-degrees (x)
- "Convert ARG from radians to degrees."
- (list '* (/ 180.0 pi) x))
-
-(provide 'lisp-float-type)
-
-;;; float-sup.el ends here
+++ /dev/null
-;;; map-ynp.el --- general-purpose boolean question-asker
-
-;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 2000 Free Software Foundation, Inc.
-
-;; Author: Roland McGrath <roland@gnu.org>
-;; Maintainer: FSF
-;; Keywords: lisp, extensions
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; map-y-or-n-p is a general-purpose question-asking function.
-;; It asks a series of y/n questions (a la y-or-n-p), and decides to
-;; apply an action to each element of a list based on the answer.
-;; The nice thing is that you also get some other possible answers
-;; to use, reminiscent of query-replace: ! to answer y to all remaining
-;; questions; ESC or q to answer n to all remaining questions; . to answer
-;; y once and then n for the remainder; and you can get help with C-h.
-
-;;; Code:
-
-(defun map-y-or-n-p (prompter actor list &optional help action-alist
- no-cursor-in-echo-area)
- "Ask a series of boolean questions.
-Takes args PROMPTER ACTOR LIST, and optional args HELP and ACTION-ALIST.
-
-LIST is a list of objects, or a function of no arguments to return the next
-object or nil.
-
-If PROMPTER is a string, the prompt is \(format PROMPTER OBJECT\). If not
-a string, PROMPTER is a function of one arg (an object from LIST), which
-returns a string to be used as the prompt for that object. If the return
-value is not a string, it may be nil to ignore the object or non-nil to act
-on the object without asking the user.
-
-ACTOR is a function of one arg (an object from LIST),
-which gets called with each object that the user answers `yes' for.
-
-If HELP is given, it is a list (OBJECT OBJECTS ACTION),
-where OBJECT is a string giving the singular noun for an elt of LIST;
-OBJECTS is the plural noun for elts of LIST, and ACTION is a transitive
-verb describing ACTOR. The default is \(\"object\" \"objects\" \"act on\"\).
-
-At the prompts, the user may enter y, Y, or SPC to act on that object;
-n, N, or DEL to skip that object; ! to act on all following objects;
-ESC or q to exit (skip all following objects); . (period) to act on the
-current object and then exit; or \\[help-command] to get help.
-
-If ACTION-ALIST is given, it is an alist (KEY FUNCTION HELP) of extra keys
-that will be accepted. KEY is a character; FUNCTION is a function of one
-arg (an object from LIST); HELP is a string. When the user hits KEY,
-FUNCTION is called. If it returns non-nil, the object is considered
-\"acted upon\", and the next object from LIST is processed. If it returns
-nil, the prompt is repeated for the same object.
-
-Final optional argument NO-CURSOR-IN-ECHO-AREA non-nil says not to set
-`cursor-in-echo-area' while prompting.
-
-This function uses `query-replace-map' to define the standard responses,
-but not all of the responses which `query-replace' understands
-are meaningful here.
-
-Returns the number of actions taken."
- (let* ((actions 0)
- user-keys mouse-event map prompt char elt tail def
- ;; Non-nil means we should use mouse menus to ask.
- use-menus
- delayed-switch-frame
- (next (if (or (and list (symbolp list))
- (subrp list)
- (byte-code-function-p list)
- (and (consp list)
- (eq (car list) 'lambda)))
- (function (lambda ()
- (setq elt (funcall list))))
- (function (lambda ()
- (if list
- (progn
- (setq elt (car list)
- list (cdr list))
- t)
- nil))))))
- (if (and (listp last-nonmenu-event)
- use-dialog-box)
- ;; Make a list describing a dialog box.
- (let ((object (if help (capitalize (nth 0 help))))
- (objects (if help (capitalize (nth 1 help))))
- (action (if help (capitalize (nth 2 help)))))
- (setq map `(("Yes" . act) ("No" . skip) ("Quit" . exit)
- (,(if help (concat action " " object " And Quit")
- "Do it and Quit") . act-and-exit)
- (,(if help (concat action " All " objects)
- "Do All") . automatic)
- ,@(mapcar (lambda (elt)
- (cons (capitalize (nth 2 elt))
- (vector (nth 1 elt))))
- action-alist))
- use-menus t
- mouse-event last-nonmenu-event))
- (setq user-keys (if action-alist
- (concat (mapconcat (function
- (lambda (elt)
- (key-description
- (char-to-string (car elt)))))
- action-alist ", ")
- " ")
- "")
- ;; Make a map that defines each user key as a vector containing
- ;; its definition.
- map (cons 'keymap
- (append (mapcar (lambda (elt)
- (cons (car elt) (vector (nth 1 elt))))
- action-alist)
- query-replace-map))))
- (unwind-protect
- (progn
- (if (stringp prompter)
- (setq prompter `(lambda (object)
- (format ,prompter object))))
- (while (funcall next)
- (setq prompt (funcall prompter elt))
- (cond ((stringp prompt)
- ;; Prompt the user about this object.
- (setq quit-flag nil)
- (if use-menus
- (setq def (or (x-popup-dialog (or mouse-event use-menus)
- (cons prompt map))
- 'quit))
- ;; Prompt in the echo area.
- (let ((cursor-in-echo-area (not no-cursor-in-echo-area))
- (message-log-max nil))
- (message "%s(y, n, !, ., q, %sor %s) "
- prompt user-keys
- (key-description (vector help-char)))
- (if minibuffer-auto-raise
- (raise-frame (window-frame (minibuffer-window))))
- (while (progn
- (setq char (read-event))
- ;; If we get -1, from end of keyboard
- ;; macro, try again.
- (equal char -1)))
- ;; Show the answer to the question.
- (message "%s(y, n, !, ., q, %sor %s) %s"
- prompt user-keys
- (key-description (vector help-char))
- (single-key-description char)))
- (setq def (lookup-key map (vector char))))
- (cond ((eq def 'exit)
- (setq next (function (lambda () nil))))
- ((eq def 'act)
- ;; Act on the object.
- (funcall actor elt)
- (setq actions (1+ actions)))
- ((eq def 'skip)
- ;; Skip the object.
- )
- ((eq def 'act-and-exit)
- ;; Act on the object and then exit.
- (funcall actor elt)
- (setq actions (1+ actions)
- next (function (lambda () nil))))
- ((eq def 'quit)
- (setq quit-flag t)
- (setq next `(lambda ()
- (setq next ',next)
- ',elt)))
- ((eq def 'automatic)
- ;; Act on this and all following objects.
- (if (funcall prompter elt)
- (progn
- (funcall actor elt)
- (setq actions (1+ actions))))
- (while (funcall next)
- (if (funcall prompter elt)
- (progn
- (funcall actor elt)
- (setq actions (1+ actions))))))
- ((eq def 'help)
- (with-output-to-temp-buffer "*Help*"
- (princ
- (let ((object (if help (nth 0 help) "object"))
- (objects (if help (nth 1 help) "objects"))
- (action (if help (nth 2 help) "act on")))
- (concat
- (format "Type SPC or `y' to %s the current %s;
-DEL or `n' to skip the current %s;
-RET or `q' to exit (skip all remaining %s);
-C-g to quit (cancel the operation);
-! to %s all remaining %s;\n"
- action object object objects action
- objects)
- (mapconcat (function
- (lambda (elt)
- (format "%s to %s"
- (single-key-description
- (nth 0 elt))
- (nth 2 elt))))
- action-alist
- ";\n")
- (if action-alist ";\n")
- (format "or . (period) to %s \
-the current %s and exit."
- action object))))
- (save-excursion
- (set-buffer standard-output)
- (help-mode)))
-
- (setq next `(lambda ()
- (setq next ',next)
- ',elt)))
- ((vectorp def)
- ;; A user-defined key.
- (if (funcall (aref def 0) elt) ;Call its function.
- ;; The function has eaten this object.
- (setq actions (1+ actions))
- ;; Regurgitated; try again.
- (setq next `(lambda ()
- (setq next ',next)
- ',elt))))
- ((and (consp char)
- (eq (car char) 'switch-frame))
- ;; switch-frame event. Put it off until we're done.
- (setq delayed-switch-frame char)
- (setq next `(lambda ()
- (setq next ',next)
- ',elt)))
- (t
- ;; Random char.
- (message "Type %s for help."
- (key-description (vector help-char)))
- (beep)
- (sit-for 1)
- (setq next `(lambda ()
- (setq next ',next)
- ',elt)))))
- (prompt
- (funcall actor elt)
- (setq actions (1+ actions))))))
- (if delayed-switch-frame
- (setq unread-command-events
- (cons delayed-switch-frame unread-command-events))))
- ;; Clear the last prompt from the minibuffer.
- (let ((message-log-max nil))
- (message ""))
- ;; Return the number of actions that were taken.
- actions))
-
-;;; map-ynp.el ends here
+++ /dev/null
-;;; regi.el --- REGular expression Interpreting engine
-
-;; Copyright (C) 1993 Free Software Foundation, Inc.
-
-;; Author: 1993 Barry A. Warsaw, Century Computing, Inc. <bwarsaw@cen.com>
-;; Maintainer: bwarsaw@cen.com
-;; Created: 24-Feb-1993
-;; Version: 1.8
-;; Last Modified: 1993/06/01 21:33:00
-;; Keywords: extensions, matching
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-\f
-(defun regi-pos (&optional position col-p)
- "Return the character position at various buffer positions.
-Optional POSITION can be one of the following symbols:
-
-`bol' == beginning of line
-`boi' == beginning of indentation
-`eol' == end of line [default]
-`bonl' == beginning of next line
-`bopl' == beginning of previous line
-
-Optional COL-P non-nil returns `current-column' instead of character position."
- (save-excursion
- (cond
- ((eq position 'bol) (beginning-of-line))
- ((eq position 'boi) (back-to-indentation))
- ((eq position 'bonl) (forward-line 1))
- ((eq position 'bopl) (forward-line -1))
- (t (end-of-line)))
- (if col-p (current-column) (point))))
-
-(defun regi-mapcar (predlist func &optional negate-p case-fold-search-p)
- "Build a regi frame where each element of PREDLIST appears exactly once.
-The frame contains elements where each member of PREDLIST is
-associated with FUNC, and optionally NEGATE-P and CASE-FOLD-SEARCH-P."
- (let (frame tail)
- (if (or negate-p case-fold-search-p)
- (setq tail (list negate-p)))
- (if case-fold-search-p
- (setq tail (append tail (list case-fold-search-p))))
- (while predlist
- (let ((element (list (car predlist) func)))
- (if tail
- (setq element (append element tail)))
- (setq frame (append frame (list element))
- predlist (cdr predlist))
- ))
- frame))
-
-\f
-(defun regi-interpret (frame &optional start end)
- "Interpret the regi frame FRAME.
-If optional START and END are supplied, they indicate the region of
-interest, and the buffer is narrowed to the beginning of the line
-containing START, and beginning of the line after the line containing
-END. Otherwise, point and mark are not set and processing continues
-until your FUNC returns the `abort' symbol (see below). Beware! Not
-supplying a START or END could put you in an infinite loop.
-
-A regi frame is a list of entries of the form:
-
- (PRED FUNC [NEGATE-P [CASE-FOLD-SEARCH]])
-
-PRED is a predicate against which each line in the region is tested,
-and if a match occurs, FUNC is `eval'd. Point is then moved to the
-beginning of the next line, the frame is reset and checking continues.
-If a match doesn't occur, the next entry is checked against the
-current line until all entries in the frame are checked. At this
-point, if no match occurred, the frame is reset and point is moved to
-the next line. Checking continues until every line in the region is
-checked. Optional NEGATE-P inverts the result of PRED before FUNC is
-called and `case-fold-search' is bound to the optional value of
-CASE-FOLD-SEARCH for the PRED check.
-
-PRED can be a string, variable, function or one of the following
-symbols: t, nil, `begin', `end', and `every'. If PRED is a string, or
-a variable or list that evaluates to a string, it is interpreted as a
-regular expression and is matched against the current line (from the
-beginning) using `looking-at'. If PRED does not evaluate to a string,
-it is interpreted as a binary value (nil or non-nil).
-
-PRED can also be one of the following symbols:
-
-t -- always produces a true outcome
-`begin' -- always executes before anything else
-`end' -- always executes after everything else
-`every' -- execute after frame is matched on a line
-
-Note that NEGATE-P and CASE-FOLD-SEARCH are meaningless if PRED is one
-of these special symbols. Only the first occurrence of each symbol in
-a frame entry is used, the rest are ignored.
-
-Your FUNC can return values which control regi processing. If a list
-is returned from your function, it can contain any combination of the
-following elements:
-
-the symbol `continue'
- Tells regi to continue processing frame-entries after a match,
- instead of resetting to the first entry and advancing to the next
- line, as is the default behavior. When returning this symbol,
- you must take care not to enter an infinite loop.
-
-the symbol `abort'
- Tells regi to terminate processing this frame. any end
- frame-entry is still processed.
-
-the list `(frame . NEWFRAME)'
- Tells regi to use NEWFRAME as its current frame. In other words,
- your FUNC can modify the executing regi frame on the fly.
-
-the list `(step . STEP)'
- Tells regi to move STEP number of lines forward during normal
- processing. By default, regi moves forward 1 line. STEP can be
- negative, but be careful of infinite loops.
-
-You should usually take care to explicitly return nil from your
-function if no action is to take place. Your FUNC will always be
-`eval'ed. The following variables will be temporarily bound to some
-useful information:
-
-`curline'
- the current line in the buffer, as a string
-
-`curframe'
- the full, current frame being executed
-
-`curentry'
- the current frame entry being executed."
-
- (save-excursion
- (save-restriction
- (let (begin-tag end-tag every-tag current-frame working-frame donep)
-
- ;; set up the narrowed region
- (and start
- end
- (let* ((tstart start)
- (start (min start end))
- (end (max start end)))
- (narrow-to-region
- (progn (goto-char end) (regi-pos 'bonl))
- (progn (goto-char start) (regi-pos 'bol)))))
-
- ;; lets find the special tags and remove them from the working
- ;; frame. note that only the last special tag is used.
- (mapcar
- (function
- (lambda (entry)
- (let ((pred (car entry))
- (func (car (cdr entry))))
- (cond
- ((eq pred 'begin) (setq begin-tag func))
- ((eq pred 'end) (setq end-tag func))
- ((eq pred 'every) (setq every-tag func))
- (t
- (setq working-frame (append working-frame (list entry))))
- ) ; end-cond
- )))
- frame) ; end-mapcar
-
- ;; execute the begin entry
- (eval begin-tag)
-
- ;; now process the frame
- (setq current-frame working-frame)
- (while (not (or donep (eobp)))
- (let* ((entry (car current-frame))
- (pred (nth 0 entry))
- (func (nth 1 entry))
- (negate-p (nth 2 entry))
- (case-fold-search (nth 3 entry))
- match-p)
- (catch 'regi-throw-top
- (cond
- ;; we are finished processing the frame for this line
- ((not current-frame)
- (setq current-frame working-frame) ;reset frame
- (forward-line 1)
- (throw 'regi-throw-top t))
- ;; see if predicate evaluates to a string
- ((stringp (setq match-p (eval pred)))
- (setq match-p (looking-at match-p)))
- ) ; end-cond
-
- ;; now that we've done the initial matching, check for
- ;; negation of match
- (and negate-p
- (setq match-p (not match-p)))
-
- ;; if the line matched, package up the argument list and
- ;; funcall the FUNC
- (if match-p
- (let* ((curline (buffer-substring
- (regi-pos 'bol)
- (regi-pos 'eol)))
- (curframe current-frame)
- (curentry entry)
- (result (eval func))
- (step (or (cdr (assq 'step result)) 1))
- )
- ;; changing frame on the fly?
- (if (assq 'frame result)
- (setq working-frame (cdr (assq 'frame result))))
-
- ;; continue processing current frame?
- (if (memq 'continue result)
- (setq current-frame (cdr current-frame))
- (forward-line step)
- (setq current-frame working-frame))
-
- ;; abort current frame?
- (if (memq 'abort result)
- (progn
- (setq donep t)
- (throw 'regi-throw-top t)))
- ) ; end-let
-
- ;; else if no match occurred, then process the next
- ;; frame-entry on the current line
- (setq current-frame (cdr current-frame))
-
- ) ; end-if match-p
- ) ; end catch
- ) ; end let
-
- ;; after every cycle, evaluate every-tag
- (eval every-tag)
- ) ; end-while
-
- ;; now process the end entry
- (eval end-tag)))))
-
-\f
-(provide 'regi)
-
-;;; regi.el ends here
+++ /dev/null
-;;; timer.el --- run a function with args at some time in future
-
-;; Copyright (C) 1996 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This package gives you the capability to run Emacs Lisp commands at
-;; specified times in the future, either as one-shots or periodically.
-
-;;; Code:
-
-;; Layout of a timer vector:
-;; [triggered-p high-seconds low-seconds usecs repeat-delay
-;; function args idle-delay]
-
-(defun timer-create ()
- "Create a timer object."
- (let ((timer (make-vector 8 nil)))
- (aset timer 0 t)
- timer))
-
-(defun timerp (object)
- "Return t if OBJECT is a timer."
- (and (vectorp object) (= (length object) 8)))
-
-(defun timer-set-time (timer time &optional delta)
- "Set the trigger time of TIMER to TIME.
-TIME must be in the internal format returned by, e.g., `current-time'.
-If optional third argument DELTA is a positive number, make the timer
-fire repeatedly that many seconds apart."
- (or (timerp timer)
- (error "Invalid timer"))
- (aset timer 1 (car time))
- (aset timer 2 (if (consp (cdr time)) (car (cdr time)) (cdr time)))
- (aset timer 3 (or (and (consp (cdr time)) (consp (cdr (cdr time)))
- (nth 2 time))
- 0))
- (aset timer 4 (and (numberp delta) (> delta 0) delta))
- timer)
-
-(defun timer-set-idle-time (timer secs &optional repeat)
- "Set the trigger idle time of TIMER to SECS.
-If optional third argument REPEAT is non-nil, make the timer
-fire each time Emacs is idle for that many seconds."
- (or (timerp timer)
- (error "Invalid timer"))
- (aset timer 1 0)
- (aset timer 2 0)
- (aset timer 3 0)
- (timer-inc-time timer secs)
- (aset timer 4 repeat)
- timer)
-
-(defun timer-next-integral-multiple-of-time (time secs)
- "Yield the next value after TIME that is an integral multiple of SECS.
-More precisely, the next value, after TIME, that is an integral multiple
-of SECS seconds since the epoch. SECS may be a fraction."
- (let ((time-base (ash 1 16)))
- (if (fboundp 'atan)
- ;; Use floating point, taking care to not lose precision.
- (let* ((float-time-base (float time-base))
- (million 1000000.0)
- (time-usec (+ (* million
- (+ (* float-time-base (nth 0 time))
- (nth 1 time)))
- (nth 2 time)))
- (secs-usec (* million secs))
- (mod-usec (mod time-usec secs-usec))
- (next-usec (+ (- time-usec mod-usec) secs-usec))
- (time-base-million (* float-time-base million)))
- (list (floor next-usec time-base-million)
- (floor (mod next-usec time-base-million) million)
- (floor (mod next-usec million))))
- ;; Floating point is not supported.
- ;; Use integer arithmetic, avoiding overflow if possible.
- (let* ((mod-sec (mod (+ (* (mod time-base secs)
- (mod (nth 0 time) secs))
- (nth 1 time))
- secs))
- (next-1-sec (+ (- (nth 1 time) mod-sec) secs)))
- (list (+ (nth 0 time) (floor next-1-sec time-base))
- (mod next-1-sec time-base)
- 0)))))
-
-(defun timer-relative-time (time secs &optional usecs)
- "Advance TIME by SECS seconds and optionally USECS microseconds.
-SECS may be a fraction."
- (let ((high (car time))
- (low (if (consp (cdr time)) (nth 1 time) (cdr time)))
- (micro (if (numberp (car-safe (cdr-safe (cdr time))))
- (nth 2 time)
- 0)))
- ;; Add
- (if usecs (setq micro (+ micro usecs)))
- (if (floatp secs)
- (setq micro (+ micro (floor (* 1000000 (- secs (floor secs)))))))
- (setq low (+ low (floor secs)))
-
- ;; Normalize
- ;; `/' rounds towards zero while `mod' returns a positive number,
- ;; so we can't rely on (= a (+ (* 100 (/ a 100)) (mod a 100))).
- (setq low (+ low (/ micro 1000000) (if (< micro 0) -1 0)))
- (setq micro (mod micro 1000000))
- (setq high (+ high (/ low 65536) (if (< low 0) -1 0)))
- (setq low (logand low 65535))
-
- (list high low (and (/= micro 0) micro))))
-
-(defun timer-inc-time (timer secs &optional usecs)
- "Increment the time set in TIMER by SECS seconds and USECS microseconds.
-SECS may be a fraction. If USECS is omitted, that means it is zero."
- (let ((time (timer-relative-time
- (list (aref timer 1) (aref timer 2) (aref timer 3))
- secs
- usecs)))
- (aset timer 1 (nth 0 time))
- (aset timer 2 (nth 1 time))
- (aset timer 3 (or (nth 2 time) 0))))
-
-(defun timer-set-time-with-usecs (timer time usecs &optional delta)
- "Set the trigger time of TIMER to TIME plus USECS.
-TIME must be in the internal format returned by, e.g., `current-time'.
-The microsecond count from TIME is ignored, and USECS is used instead.
-If optional fourth argument DELTA is a positive number, make the timer
-fire repeatedly that many seconds apart."
- (or (timerp timer)
- (error "Invalid timer"))
- (aset timer 1 (nth 0 time))
- (aset timer 2 (nth 1 time))
- (aset timer 3 usecs)
- (aset timer 4 (and (numberp delta) (> delta 0) delta))
- timer)
-(make-obsolete 'timer-set-time-with-usecs
- "use `timer-set-time' and `timer-inc-time' instead."
- "21.4")
-
-(defun timer-set-function (timer function &optional args)
- "Make TIMER call FUNCTION with optional ARGS when triggering."
- (or (timerp timer)
- (error "Invalid timer"))
- (aset timer 5 function)
- (aset timer 6 args)
- timer)
-\f
-(defun timer-activate (timer)
- "Put TIMER on the list of active timers."
- (if (and (timerp timer)
- (integerp (aref timer 1))
- (integerp (aref timer 2))
- (integerp (aref timer 3))
- (aref timer 5))
- (let ((timers timer-list)
- last)
- ;; Skip all timers to trigger before the new one.
- (while (and timers
- (or (> (aref timer 1) (aref (car timers) 1))
- (and (= (aref timer 1) (aref (car timers) 1))
- (> (aref timer 2) (aref (car timers) 2)))
- (and (= (aref timer 1) (aref (car timers) 1))
- (= (aref timer 2) (aref (car timers) 2))
- (> (aref timer 3) (aref (car timers) 3)))))
- (setq last timers
- timers (cdr timers)))
- ;; Insert new timer after last which possibly means in front of queue.
- (if last
- (setcdr last (cons timer timers))
- (setq timer-list (cons timer timers)))
- (aset timer 0 nil)
- (aset timer 7 nil)
- nil)
- (error "Invalid or uninitialized timer")))
-
-(defun timer-activate-when-idle (timer &optional dont-wait)
- "Arrange to activate TIMER whenever Emacs is next idle.
-If optional argument DONT-WAIT is non-nil, then enable the
-timer to activate immediately, or at the right time, if Emacs
-is already idle."
- (if (and (timerp timer)
- (integerp (aref timer 1))
- (integerp (aref timer 2))
- (integerp (aref timer 3))
- (aref timer 5))
- (let ((timers timer-idle-list)
- last)
- ;; Skip all timers to trigger before the new one.
- (while (and timers
- (or (> (aref timer 1) (aref (car timers) 1))
- (and (= (aref timer 1) (aref (car timers) 1))
- (> (aref timer 2) (aref (car timers) 2)))
- (and (= (aref timer 1) (aref (car timers) 1))
- (= (aref timer 2) (aref (car timers) 2))
- (> (aref timer 3) (aref (car timers) 3)))))
- (setq last timers
- timers (cdr timers)))
- ;; Insert new timer after last which possibly means in front of queue.
- (if last
- (setcdr last (cons timer timers))
- (setq timer-idle-list (cons timer timers)))
- (aset timer 0 (not dont-wait))
- (aset timer 7 t)
- nil)
- (error "Invalid or uninitialized timer")))
-
-;;;###autoload
-(defalias 'disable-timeout 'cancel-timer)
-;;;###autoload
-(defun cancel-timer (timer)
- "Remove TIMER from the list of active timers."
- (or (timerp timer)
- (error "Invalid timer"))
- (setq timer-list (delq timer timer-list))
- (setq timer-idle-list (delq timer timer-idle-list))
- nil)
-
-;;;###autoload
-(defun cancel-function-timers (function)
- "Cancel all timers scheduled by `run-at-time' which would run FUNCTION."
- (interactive "aCancel timers of function: ")
- (let ((tail timer-list))
- (while tail
- (if (eq (aref (car tail) 5) function)
- (setq timer-list (delq (car tail) timer-list)))
- (setq tail (cdr tail))))
- (let ((tail timer-idle-list))
- (while tail
- (if (eq (aref (car tail) 5) function)
- (setq timer-idle-list (delq (car tail) timer-idle-list)))
- (setq tail (cdr tail)))))
-\f
-;; Record the last few events, for debugging.
-(defvar timer-event-last-2 nil)
-(defvar timer-event-last-1 nil)
-(defvar timer-event-last nil)
-
-(defvar timer-max-repeats 10
- "*Maximum number of times to repeat a timer, if real time jumps.")
-
-(defun timer-until (timer time)
- "Calculate number of seconds from when TIMER will run, until TIME.
-TIMER is a timer, and stands for the time when its next repeat is scheduled.
-TIME is a time-list."
- (let ((high (- (car time) (aref timer 1)))
- (low (- (nth 1 time) (aref timer 2))))
- (+ low (* high 65536))))
-
-(defun timer-event-handler (timer)
- "Call the handler for the timer TIMER.
-This function is called, by name, directly by the C code."
- (setq timer-event-last-2 timer-event-last-1)
- (setq timer-event-last-1 timer-event-last)
- (setq timer-event-last timer)
- (let ((inhibit-quit t))
- (if (timerp timer)
- (progn
- ;; Delete from queue.
- (cancel-timer timer)
- ;; Re-schedule if requested.
- (if (aref timer 4)
- (if (aref timer 7)
- (timer-activate-when-idle timer)
- (timer-inc-time timer (aref timer 4) 0)
- ;; If real time has jumped forward,
- ;; perhaps because Emacs was suspended for a long time,
- ;; limit how many times things get repeated.
- (if (and (numberp timer-max-repeats)
- (< 0 (timer-until timer (current-time))))
- (let ((repeats (/ (timer-until timer (current-time))
- (aref timer 4))))
- (if (> repeats timer-max-repeats)
- (timer-inc-time timer (* (aref timer 4) repeats)))))
- (timer-activate timer)))
- ;; Run handler.
- ;; We do this after rescheduling so that the handler function
- ;; can cancel its own timer successfully with cancel-timer.
- (condition-case nil
- (apply (aref timer 5) (aref timer 6))
- (error nil)))
- (error "Bogus timer event"))))
-
-;; This function is incompatible with the one in levents.el.
-(defun timeout-event-p (event)
- "Non-nil if EVENT is a timeout event."
- (and (listp event) (eq (car event) 'timer-event)))
-\f
-;;;###autoload
-(defun run-at-time (time repeat function &rest args)
- "Perform an action at time TIME.
-Repeat the action every REPEAT seconds, if REPEAT is non-nil.
-TIME should be a string like \"11:23pm\", nil meaning now, a number of seconds
-from now, a value from `current-time', or t (with non-nil REPEAT)
-meaning the next integral multiple of REPEAT.
-REPEAT may be an integer or floating point number.
-The action is to call FUNCTION with arguments ARGS.
-
-This function returns a timer object which you can use in `cancel-timer'."
- (interactive "sRun at time: \nNRepeat interval: \naFunction: ")
-
- (or (null repeat)
- (and (numberp repeat) (< 0 repeat))
- (error "Invalid repetition interval"))
-
- ;; Special case: nil means "now" and is useful when repeating.
- (if (null time)
- (setq time (current-time)))
-
- ;; Special case: t means the next integral multiple of REPEAT.
- (if (and (eq time t) repeat)
- (setq time (timer-next-integral-multiple-of-time (current-time) repeat)))
-
- ;; Handle numbers as relative times in seconds.
- (if (numberp time)
- (setq time (timer-relative-time (current-time) time)))
-
- ;; Handle relative times like "2 hours and 35 minutes"
- (if (stringp time)
- (let ((secs (timer-duration time)))
- (if secs
- (setq time (timer-relative-time (current-time) secs)))))
-
- ;; Handle "11:23pm" and the like. Interpret it as meaning today
- ;; which admittedly is rather stupid if we have passed that time
- ;; already. (Though only Emacs hackers hack Emacs at that time.)
- (if (stringp time)
- (progn
- (require 'diary-lib)
- (let ((hhmm (diary-entry-time time))
- (now (decode-time)))
- (if (>= hhmm 0)
- (setq time
- (encode-time 0 (% hhmm 100) (/ hhmm 100) (nth 3 now)
- (nth 4 now) (nth 5 now) (nth 8 now)))))))
-
- (or (consp time)
- (error "Invalid time format"))
-
- (let ((timer (timer-create)))
- (timer-set-time timer time repeat)
- (timer-set-function timer function args)
- (timer-activate timer)
- timer))
-
-;;;###autoload
-(defun run-with-timer (secs repeat function &rest args)
- "Perform an action after a delay of SECS seconds.
-Repeat the action every REPEAT seconds, if REPEAT is non-nil.
-SECS and REPEAT may be integers or floating point numbers.
-The action is to call FUNCTION with arguments ARGS.
-
-This function returns a timer object which you can use in `cancel-timer'."
- (interactive "sRun after delay (seconds): \nNRepeat interval: \naFunction: ")
- (apply 'run-at-time secs repeat function args))
-
-;;;###autoload
-(defun add-timeout (secs function object &optional repeat)
- "Add a timer to run SECS seconds from now, to call FUNCTION on OBJECT.
-If REPEAT is non-nil, repeat the timer every REPEAT seconds.
-This function is for compatibility; see also `run-with-timer'."
- (run-with-timer secs repeat function object))
-
-;;;###autoload
-(defun run-with-idle-timer (secs repeat function &rest args)
- "Perform an action the next time Emacs is idle for SECS seconds.
-The action is to call FUNCTION with arguments ARGS.
-SECS may be an integer or a floating point number.
-
-If REPEAT is non-nil, do the action each time Emacs has been idle for
-exactly SECS seconds (that is, only once for each time Emacs becomes idle).
-
-This function returns a timer object which you can use in `cancel-timer'."
- (interactive
- (list (read-from-minibuffer "Run after idle (seconds): " nil nil t)
- (y-or-n-p "Repeat each time Emacs is idle? ")
- (intern (completing-read "Function: " obarray 'fboundp t))))
- (let ((timer (timer-create)))
- (timer-set-function timer function args)
- (timer-set-idle-time timer secs repeat)
- (timer-activate-when-idle timer)
- timer))
-\f
-(defun with-timeout-handler (tag)
- (throw tag 'timeout))
-
-;;;###autoload (put 'with-timeout 'lisp-indent-function 1)
-
-;;;###autoload
-(defmacro with-timeout (list &rest body)
- "Run BODY, but if it doesn't finish in SECONDS seconds, give up.
-If we give up, we run the TIMEOUT-FORMS and return the value of the last one.
-The call should look like:
- (with-timeout (SECONDS TIMEOUT-FORMS...) BODY...)
-The timeout is checked whenever Emacs waits for some kind of external
-event \(such as keyboard input, input from subprocesses, or a certain time);
-if the program loops without waiting in any way, the timeout will not
-be detected."
- (let ((seconds (car list))
- (timeout-forms (cdr list)))
- `(let ((with-timeout-tag (cons nil nil))
- with-timeout-value with-timeout-timer)
- (if (catch with-timeout-tag
- (progn
- (setq with-timeout-timer
- (run-with-timer ,seconds nil
- 'with-timeout-handler
- with-timeout-tag))
- (setq with-timeout-value (progn . ,body))
- nil))
- (progn . ,timeout-forms)
- (cancel-timer with-timeout-timer)
- with-timeout-value))))
-
-(defun y-or-n-p-with-timeout (prompt seconds default-value)
- "Like (y-or-n-p PROMPT), with a timeout.
-If the user does not answer after SECONDS seconds, return DEFAULT-VALUE."
- (with-timeout (seconds default-value)
- (y-or-n-p prompt)))
-\f
-(defvar timer-duration-words
- (list (cons "microsec" 0.000001)
- (cons "microsecond" 0.000001)
- (cons "millisec" 0.001)
- (cons "millisecond" 0.001)
- (cons "sec" 1)
- (cons "second" 1)
- (cons "min" 60)
- (cons "minute" 60)
- (cons "hour" (* 60 60))
- (cons "day" (* 24 60 60))
- (cons "week" (* 7 24 60 60))
- (cons "fortnight" (* 14 24 60 60))
- (cons "month" (* 30 24 60 60)) ; Approximation
- (cons "year" (* 365.25 24 60 60)) ; Approximation
- )
- "Alist mapping temporal words to durations in seconds")
-
-(defun timer-duration (string)
- "Return number of seconds specified by STRING, or nil if parsing fails."
- (let ((secs 0)
- (start 0)
- (case-fold-search t))
- (while (string-match
- "[ \t]*\\([0-9.]+\\)?[ \t]*\\([a-z]+[a-rt-z]\\)s?[ \t]*"
- string start)
- (let ((count (if (match-beginning 1)
- (string-to-number (match-string 1 string))
- 1))
- (itemsize (cdr (assoc (match-string 2 string)
- timer-duration-words))))
- (if itemsize
- (setq start (match-end 0)
- secs (+ secs (* count itemsize)))
- (setq secs nil
- start (length string)))))
- (if (= start (length string))
- secs
- (if (string-match "\\`[0-9.]+\\'" string)
- (string-to-number string)))))
-\f
-(provide 'timer)
-
-;;; timer.el ends here
+++ /dev/null
-;;; warnings.el --- log and display warnings
-
-;; Copyright (C) 2002 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: internal
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This file implements the entry points `warn', `lwarn'
-;; and `display-warnings'.
-
-;;; Code:
-
-(defgroup warnings nil
- "Log and display warnings."
- :version "21.4"
- :group 'lisp)
-
-(defvar warning-levels
- '((:emergency "Emergency%s: " ding)
- (:error "Error%s: ")
- (:warning "Warning%s: ")
- (:debug "Debug%s: "))
- "List of severity level definitions for `display-warning'.
-Each element looks like (LEVEL STRING FUNCTION) and
-defines LEVEL as a severity level. STRING specifies the
-description of this level. STRING should use `%s' to
-specify where to put the warning group information,
-or it can omit the `%s' so as not to include that information.
-
-The optional FUNCTION, if non-nil, is a function to call
-with no arguments, to get the user's attention.
-
-The standard levels are :emergency, :error, :warning and :debug.
-See `display-warning' for documentation of their meanings.
-Level :debug is ignored by default (see `warning-minimum-level').")
-(put 'warning-levels 'risky-local-variable t)
-
-;; These are for compatibility with XEmacs.
-;; I don't think there is any chance of designing meaningful criteria
-;; to distinguish so many levels.
-(defvar warning-level-aliases
- '((emergency . :emergency)
- (error . :error)
- (warning . :warning)
- (notice . :warning)
- (info . :warning)
- (critical . :emergency)
- (alarm . :emergency))
- "Alist of aliases for severity levels for `display-warning'.
-Each element looks like (ALIAS . LEVEL) and defines
-ALIAS as equivalent to LEVEL. LEVEL must be defined in `warning-levels';
-it may not itself be an alias.")
-\f
-(defcustom warning-minimum-level :warning
- "Minimum severity level for displaying the warning buffer.
-If a warning's severity level is lower than this,
-the warning is logged in the warnings buffer, but the buffer
-is not immediately displayed. See also `warning-minimum-log-level'."
- :group 'warnings
- :type '(choice (const :emergency) (const :error) (const :warning))
- :version "21.4")
-(defvaralias 'display-warning-minimum-level 'warning-minimum-level)
-
-(defcustom warning-minimum-log-level :warning
- "Minimum severity level for logging a warning.
-If a warning severity level is lower than this,
-the warning is completely ignored."
- :group 'warnings
- :type '(choice (const :emergency) (const :error) (const :warning))
- :version "21.4")
-(defvaralias 'log-warning-minimum-level 'warning-minimum-log-level)
-
-(defcustom warning-suppress-log-types nil
- "List of warning types that should not be logged.
-If any element of this list matches the GROUP argument to `display-warning',
-the warning is completely ignored.
-The element must match the first elements of GROUP.
-Thus, (foo bar) as an element matches (foo bar)
-or (foo bar ANYTHING...) as GROUP.
-If GROUP is a symbol FOO, that is equivalent to the list (FOO),
-so only the element (FOO) will match it."
- :group 'warnings
- :type '(repeat (repeat symbol))
- :version "21.4")
-
-(defcustom warning-suppress-types nil
- "Custom groups for warnings not to display immediately.
-If any element of this list matches the GROUP argument to `display-warning',
-the warning is logged nonetheless, but the warnings buffer is
-not immediately displayed.
-The element must match an initial segment of the list GROUP.
-Thus, (foo bar) as an element matches (foo bar)
-or (foo bar ANYTHING...) as GROUP.
-If GROUP is a symbol FOO, that is equivalent to the list (FOO),
-so only the element (FOO) will match it.
-See also `warning-suppress-log-types'."
- :group 'warnings
- :type '(repeat (repeat symbol))
- :version "21.4")
-\f
-;;; The autoload cookie is so that programs can bind this variable
-;;; safely, testing the existing value, before they call one of the
-;;; warnings functions.
-;;;###autoload
-(defvar warning-prefix-function nil
- "Function to generate warning prefixes.
-This function, if non-nil, is called with two arguments,
-the severity level and its entry in `warning-levels',
-and should return the entry that should actually be used.
-The warnings buffer is current when this function is called
-and the function can insert text in it. This text becomes
-the beginning of the warning.")
-
-;;; The autoload cookie is so that programs can bind this variable
-;;; safely, testing the existing value, before they call one of the
-;;; warnings functions.
-;;;###autoload
-(defvar warning-series nil
- "Non-nil means treat multiple `display-warning' calls as a series.
-A marker indicates a position in the warnings buffer
-which is the start of the current series; it means that
-additional warnings in the same buffer should not move point.
-t means the next warning begins a series (and stores a marker here).
-A symbol with a function definition is like t, except
-also call that function before the next warning.")
-(put 'warning-series 'risky-local-variable t)
-
-;;; The autoload cookie is so that programs can bind this variable
-;;; safely, testing the existing value, before they call one of the
-;;; warnings functions.
-;;;###autoload
-(defvar warning-fill-prefix nil
- "Non-nil means fill each warning text using this string as `fill-prefix'.")
-
-;;; The autoload cookie is so that programs can bind this variable
-;;; safely, testing the existing value, before they call one of the
-;;; warnings functions.
-;;;###autoload
-(defvar warning-group-format " (%s)"
- "Format for displaying the warning group in the warning message.
-The result of formatting the group this way gets included in the
-message under the control of the string in `warning-levels'.")
-\f
-(defun warning-numeric-level (level)
- "Return a numeric measure of the warning severity level LEVEL."
- (let* ((elt (assq level warning-levels))
- (link (memq elt warning-levels)))
- (length link)))
-
-(defun warning-suppress-p (group suppress-list)
- "Non-nil if a warning with group GROUP should be suppressed.
-SUPPRESS-LIST is the list of kinds of warnings to suppress."
- (let (some-match)
- (dolist (elt suppress-list)
- (if (symbolp group)
- ;; If GROUP is a symbol, the ELT must be (GROUP).
- (if (and (consp elt)
- (eq (car elt) group)
- (null (cdr elt)))
- (setq some-match t))
- ;; If GROUP is a list, ELT must match it or some initial segment of it.
- (let ((tem1 group)
- (tem2 elt)
- (match t))
- ;; Check elements of ELT until we run out of them.
- (while tem2
- (if (not (equal (car tem1) (car tem2)))
- (setq match nil))
- (setq tem1 (cdr tem1)
- tem2 (cdr tem2)))
- ;; If ELT is an initial segment of GROUP, MATCH is t now.
- ;; So set SOME-MATCH.
- (if match
- (setq some-match t)))))
- ;; If some element of SUPPRESS-LIST matched,
- ;; we return t.
- some-match))
-\f
-;;;###autoload
-(defun display-warning (group message &optional level buffer-name)
- "Display a warning message, MESSAGE.
-GROUP should be a custom group name (a symbol),
-or else a list of symbols whose first element is a custom group name.
-\(The rest of the symbols represent subcategories, for warning purposes
-only, and you can use whatever symbols you like.)
-
-LEVEL should be either :warning, :error, or :emergency.
-:emergency -- a problem that will seriously impair Emacs operation soon
- if you do not attend to it promptly.
-:error -- data or circumstances that are inherently wrong.
-:warning -- data or circumstances that are not inherently wrong,
- but raise suspicion of a possible problem.
-:debug -- info for debugging only.
-
-BUFFER-NAME, if specified, is the name of the buffer for logging the
-warning. By default, it is `*Warnings*'.
-
-See the `warnings' custom group for user customization features.
-
-See also `warning-series', `warning-prefix-function' and
-`warning-fill-prefix' for additional programming features."
- (unless level
- (setq level :warning))
- (if (assq level warning-level-aliases)
- (setq level (cdr (assq level warning-level-aliases))))
- (or (< (warning-numeric-level level)
- (warning-numeric-level warning-minimum-log-level))
- (warning-suppress-p group warning-suppress-log-types)
- (let* ((groupname (if (consp group) (car group) group))
- (buffer (get-buffer-create (or buffer-name "*Warnings*")))
- (level-info (assq level warning-levels))
- start end)
- (with-current-buffer buffer
- (goto-char (point-max))
- (when (and warning-series (symbolp warning-series))
- (setq warning-series
- (prog1 (point-marker)
- (unless (eq warning-series t)
- (funcall warning-series)))))
- (unless (bolp)
- (newline))
- (setq start (point))
- (if warning-prefix-function
- (setq level-info (funcall warning-prefix-function
- level level-info)))
- (insert (format (nth 1 level-info)
- (format warning-group-format groupname))
- message)
- (newline)
- (when (and warning-fill-prefix (not (string-match "\n" message)))
- (let ((fill-prefix warning-fill-prefix)
- (fill-column 78))
- (fill-region start (point))))
- (setq end (point))
- (when (and (markerp warning-series)
- (eq (marker-buffer warning-series) buffer))
- (goto-char warning-series)))
- (if (nth 2 level-info)
- (funcall (nth 2 level-info)))
- (if noninteractive
- ;; Noninteractively, take the text we inserted
- ;; in the warnings buffer and print it.
- ;; Do this unconditionally, since there is no way
- ;; to view logged messages unless we output them.
- (with-current-buffer buffer
- (save-excursion
- ;; Don't include the final newline in the arg
- ;; to `message', because it adds a newline.
- (goto-char end)
- (if (bolp)
- (forward-char -1))
- (message "%s" (buffer-substring start (point)))))
- ;; Interactively, decide whether the warning merits
- ;; immediate display.
- (or (< (warning-numeric-level level)
- (warning-numeric-level warning-minimum-level))
- (warning-suppress-p group warning-suppress-types)
- (let ((window (display-buffer buffer)))
- (when (and (markerp warning-series)
- (eq (marker-buffer warning-series) buffer))
- (set-window-start window warning-series))
- (sit-for 0)))))))
-\f
-;;;###autoload
-(defun lwarn (group level message &rest args)
- "Display a warning message made from (format MESSAGE ARGS...).
-Aside from generating the message with `format',
-this is equivalent to `display-warning'.
-
-GROUP should be a custom group name (a symbol).
-or else a list of symbols whose first element is a custom group name.
-\(The rest of the symbols represent subcategories and
-can be whatever you like.)
-
-LEVEL should be either :warning, :error, or :emergency.
-:emergency -- a problem that will seriously impair Emacs operation soon
- if you do not attend to it promptly.
-:error -- invalid data or circumstances.
-:warning -- suspicious data or circumstances."
- (display-warning group (apply 'format message args) level))
-
-;;;###autoload
-(defun warn (message &rest args)
- "Display a warning message made from (format MESSAGE ARGS...).
-Aside from generating the message with `format',
-this is equivalent to `display-warning', using
-`emacs' as the group and `:warning' as the level."
- (display-warning 'emacs (apply 'format message args)))
-
-(provide 'warnings)
-
-;;; warnings.el ends here
HCoop / bpt / emacs.git / commitdiff