;;; subr.el --- basic lisp subroutines for Emacs
;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
+;; Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
+;; Package: emacs
;; This file is part of GNU Emacs.
`defstruct'.
To specify a value for FILEONLY without passing an argument list,
-set ARGLIST to `t'. This is necessary because `nil' means an
+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
(defmacro ignore-errors (&rest body)
"Execute BODY; if an error occurs, return nil.
Otherwise, return result of last form in BODY."
+ (declare (debug t) (indent 0))
`(condition-case nil (progn ,@body) (error nil)))
\f
;;;; Basic Lisp functions.
for the sake of consistency."
(while t
(signal 'error (list (apply 'format args)))))
-(set-advertised-calling-convention 'error '(string &rest args))
+(set-advertised-calling-convention 'error '(string &rest args) "23.1")
;; We put this here instead of in frame.el so that it's defined even on
;; systems where frame.el isn't loaded.
If N is non-nil, return the Nth-to-last link of LIST.
If N is bigger than the length of LIST, return LIST."
(if n
- (let ((m 0) (p list))
- (while (consp p)
- (setq m (1+ m) p (cdr p)))
- (if (<= n 0) p
- (if (< n m) (nthcdr (- m n) list) list)))
- (while (consp (cdr list))
- (setq list (cdr list)))
- list))
+ (and (>= n 0)
+ (let ((m (safe-length list)))
+ (if (< n m) (nthcdr (- m n) list) list)))
+ (and list
+ (nthcdr (1- (safe-length list)) list))))
(defun butlast (list &optional n)
"Return a copy of LIST with the last N elements removed."
(assoc-string key alist nil))
(defun member-ignore-case (elt list)
- "Like `member', but ignores differences in case and text representation.
+ "Like `member', but ignore differences in case and text representation.
ELT must be a string. Upper-case and lower-case letters are treated as equal.
Unibyte strings are converted to multibyte for comparison.
Non-strings in LIST are ignored."
(read-kbd-macro keys))
(defun undefined ()
+ "Beep to tell the user this binding is undefined."
(interactive)
(ding))
(defsubst posn-x-y (position)
"Return the x and y coordinates in POSITION.
-POSITION should be a list of the form returned by the `event-start'
-and `event-end' functions."
+The return value has the form (X . Y), where X and Y are given in
+pixels. POSITION should be a list of the form returned by
+`event-start' and `event-end'."
(nth 2 position))
(declare-function scroll-bar-scale "scroll-bar" (num-denom whole))
((null spacing)
(setq spacing 0)))
(cons (/ (car pair) (frame-char-width frame))
- (/ (cdr pair) (+ (frame-char-height frame) spacing))))))))
+ (- (/ (cdr pair) (+ (frame-char-height frame) spacing))
+ (if (null (with-current-buffer (window-buffer window)
+ header-line-format))
+ 0 1))))))))
(defun posn-actual-col-row (position)
"Return the actual column and row in POSITION, measured in characters.
(defsubst posn-object-x-y (position)
"Return the x and y coordinates relative to the object of POSITION.
-POSITION should be a list of the form returned by the `event-start'
-and `event-end' functions."
+The return value has the form (DX . DY), where DX and DY are
+given in pixels. POSITION should be a list of the form returned
+by `event-start' and `event-end'."
(nth 8 position))
(defsubst posn-object-width-height (position)
"Return the pixel width and height of the object of POSITION.
-POSITION should be a list of the form returned by the `event-start'
-and `event-end' functions."
+The return value has the form (WIDTH . HEIGHT). POSITION should
+be a list of the form returned by `event-start' and `event-end'."
(nth 9 position))
\f
(define-obsolete-function-alias 'eval-current-buffer 'eval-buffer "22.1")
(define-obsolete-function-alias 'string-to-int 'string-to-number "22.1")
-(make-obsolete 'char-bytes "now always returns 1." "20.4")
(make-obsolete 'forward-point "use (+ (point) N) instead." "23.1")
(defun insert-string (&rest args)
(make-obsolete 'make-variable-frame-local
"explicitly check for a frame-parameter instead." "22.2")
(make-obsolete 'interactive-p 'called-interactively-p "23.2")
-(set-advertised-calling-convention 'called-interactively-p '(kind))
+(set-advertised-calling-convention 'called-interactively-p '(kind) "23.1")
(set-advertised-calling-convention
- 'all-completions '(string collection &optional predicate))
+ 'all-completions '(string collection &optional predicate) "23.1")
+(set-advertised-calling-convention 'unintern '(name obarray) "23.3")
\f
;;;; Obsolescence declarations for variables, and aliases.
(make-obsolete-variable 'default-line-spacing 'line-spacing "23.2")
(make-obsolete-variable 'default-abbrev-mode 'abbrev-mode "23.2")
(make-obsolete-variable 'default-ctl-arrow 'ctl-arrow "23.2")
-(make-obsolete-variable 'default-direction-reversed 'direction-reversed "23.2")
(make-obsolete-variable 'default-truncate-lines 'truncate-lines "23.2")
(make-obsolete-variable 'default-left-margin 'left-margin "23.2")
(make-obsolete-variable 'default-tab-width 'tab-width "23.2")
(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
"use the appropriate faces instead."
\f
;;;; Hook manipulation functions.
-(defun make-local-hook (hook)
- "Make the hook HOOK local to the current buffer.
-The return value is HOOK.
-
-You never need to call this function now that `add-hook' does it for you
-if its LOCAL argument is non-nil.
-
-When a hook is local, its local and global values
-work in concert: running the hook actually runs all the hook
-functions listed in *either* the local value *or* the global value
-of the hook variable.
-
-This function works by making t a member of the buffer-local value,
-which acts as a flag to run the hook functions in the default value as
-well. This works for all normal hooks, but does not work for most
-non-normal hooks yet. We will be changing the callers of non-normal
-hooks so that they can handle localness; this has to be done one by
-one.
-
-This function does nothing if HOOK is already local in the current
-buffer.
-
-Do not use `make-local-variable' to make a hook variable buffer-local."
- (if (local-variable-p hook)
- nil
- (or (boundp hook) (set hook nil))
- (make-local-variable hook)
- (set hook (list t)))
- hook)
-(make-obsolete 'make-local-hook "not necessary any more." "21.1")
-
(defun add-hook (hook function &optional append local)
"Add to the value of HOOK the function FUNCTION.
FUNCTION is not added if already present.
(defun run-mode-hooks (&rest hooks)
"Run mode hooks `delayed-mode-hooks' and HOOKS, or delay HOOKS.
-Execution is delayed if `delay-mode-hooks' is non-nil.
-If `delay-mode-hooks' is nil, run `after-change-major-mode-hook'
-after running the mode hooks.
+Execution is delayed if the variable `delay-mode-hooks' is non-nil.
+Otherwise, runs the mode hooks and then `after-change-major-mode-hook'.
Major mode functions should use this instead of `run-hooks' when running their
FOO-mode-hook."
(if delay-mode-hooks
(let ((rest (cdr found)))
(setcdr found nil)
(nconc found (list (list toggle name)) rest))
- (setq minor-mode-alist (cons (list toggle name)
- minor-mode-alist)))))))
+ (push (list toggle name) minor-mode-alist))))))
;; Add the toggle to the minor-modes menu if requested.
(when (get toggle :included)
(define-key mode-line-mode-menu
(let ((rest (cdr found)))
(setcdr found nil)
(nconc found (list (cons toggle keymap)) rest))
- (setq minor-mode-map-alist (cons (cons toggle keymap)
- minor-mode-map-alist))))))))
+ (push (cons toggle keymap) minor-mode-map-alist)))))))
\f
;;; Load history
-;; (defvar symbol-file-load-history-loaded nil
-;; "Non-nil means we have loaded the file `fns-VERSION.el' in `exec-directory'.
-;; That file records the part of `load-history' for preloaded files,
-;; which is cleared out before dumping to make Emacs smaller.")
-
-;; (defun load-symbol-file-load-history ()
-;; "Load the file `fns-VERSION.el' in `exec-directory' if not already done.
-;; That file records the part of `load-history' for preloaded files,
-;; which is cleared out before dumping to make Emacs smaller."
-;; (unless symbol-file-load-history-loaded
-;; (load (expand-file-name
-;; ;; fns-XX.YY.ZZ.el does not work on DOS filesystem.
-;; (if (eq system-type 'ms-dos)
-;; "fns.el"
-;; (format "fns-%s.el" emacs-version))
-;; exec-directory)
-;; ;; The file name fns-%s.el already has a .el extension.
-;; nil nil t)
-;; (setq symbol-file-load-history-loaded t)))
-
(defun symbol-file (symbol &optional type)
"Return the name of the file that defined SYMBOL.
The value is normally an absolute file name. It can also be nil,
load-elt (and loads (car loads)))))
load-elt))
+(put 'eval-after-load 'lisp-indent-function 1)
(defun eval-after-load (file form)
"Arrange that, if FILE is ever loaded, FORM will be run at that time.
If FILE is already loaded, evaluate FORM right now.
this name matching.
Alternatively, FILE can be a feature (i.e. a symbol), in which case FORM
-is evaluated whenever that feature is `provide'd. Note that although
-provide statements are usually at the end of files, this is not always
-the case (e.g., sometimes they are at the start to avoid a recursive
-load error). If your FORM should not be evaluated until the code in
-FILE has been, do not use the symbol form for FILE in such cases.
+is evaluated at the end of any file that `provide's this feature.
Usually FILE is just a library name like \"font-lock\" or a feature name
like 'font-lock.
;; Add this FORM into after-load-alist (regardless of whether we'll be
;; evaluating it now).
(let* ((regexp-or-feature
- (if (stringp file) (setq file (purecopy (load-history-regexp file))) file))
+ (if (stringp file)
+ (setq file (purecopy (load-history-regexp file)))
+ file))
(elt (assoc regexp-or-feature after-load-alist)))
(unless elt
(setq elt (list regexp-or-feature))
(push elt after-load-alist))
+ (when (symbolp regexp-or-feature)
+ ;; For features, the after-load-alist elements get run when `provide' is
+ ;; called rather than at the end of the file. So add an indirection to
+ ;; make sure that `form' is really run "after-load" in case the provide
+ ;; call happens early.
+ (setq form
+ `(when load-file-name
+ (let ((fun (make-symbol "eval-after-load-helper")))
+ (fset fun `(lambda (file)
+ (if (not (equal file ',load-file-name))
+ nil
+ (remove-hook 'after-load-functions ',fun)
+ ,',form)))
+ (add-hook 'after-load-functions fun)))))
;; Add FORM to the element unless it's already there.
(unless (member form (cdr elt))
(nconc elt (purecopy (list form))))
some sort of escape sequence, the ambiguity is resolved via `read-key-delay'."
(let ((overriding-terminal-local-map read-key-empty-map)
(overriding-local-map nil)
+ (echo-keystrokes 0)
(old-global-map (current-global-map))
(timer (run-with-idle-timer
;; Wait long enough that Emacs has the time to receive and
(throw 'read-key keys)))))))
(unwind-protect
(progn
- (use-global-map read-key-empty-map)
+ (use-global-map
+ (let ((map (make-sparse-keymap)))
+ ;; Don't hide the menu-bar and tool-bar entries.
+ (define-key map [menu-bar] (lookup-key global-map [menu-bar]))
+ (define-key map [tool-bar] (lookup-key global-map [tool-bar]))
+ map))
(aref (catch 'read-key (read-key-sequence-vector prompt nil t)) 0))
(cancel-timer timer)
(use-global-map old-global-map))))
(if inhibit-quit (setq quit-flag nil)))
;; Translate TAB key into control-I ASCII character, and so on.
;; Note: `read-char' does it using the `ascii-character' property.
- ;; 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
- (if (integerp char)
- (char-resolve-modifiers char)
- char))
+ ;; We should try and use read-key instead.
(let ((translation (lookup-key local-function-key-map (vector char))))
- (if (arrayp translation)
- (setq translated (aref translation 0))))
+ (setq translated (if (arrayp translation)
+ (aref translation 0)
+ char)))
+ (if (integerp translated)
+ (setq translated (char-resolve-modifiers translated)))
(cond ((null translated))
((not (integerp translated))
(setq unread-command-events (list char)
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.
+then it returns nil if the user types C-g, but `quit-flag' remains set.
Once the caller uses the password, it can erase the password
by doing (clear-string STRING)."
t)))
n))
+(defun read-char-choice (prompt chars &optional inhibit-keyboard-quit)
+ "Read and return one of CHARS, prompting for PROMPT.
+Any input that is not one of CHARS is ignored.
+
+If optional argument INHIBIT-KEYBOARD-QUIT is non-nil, ignore
+keyboard-quit events while waiting for a valid input."
+ (unless (consp chars)
+ (error "Called `read-char-choice' without valid char choices"))
+ (let ((cursor-in-echo-area t)
+ (executing-kbd-macro executing-kbd-macro)
+ char done)
+ (while (not done)
+ (unless (get-text-property 0 'face prompt)
+ (setq prompt (propertize prompt 'face 'minibuffer-prompt)))
+ (setq char (let ((inhibit-quit inhibit-keyboard-quit))
+ (read-key prompt)))
+ (cond
+ ((not (numberp char)))
+ ((memq char chars)
+ (setq done t))
+ ((and executing-kbd-macro (= char -1))
+ ;; read-event returns -1 if we are in a kbd macro and
+ ;; there are no more events in the macro. Attempt to
+ ;; get an event interactively.
+ (setq executing-kbd-macro nil))))
+ ;; Display the question with the answer.
+ (message "%s%s" prompt (char-to-string char))
+ char))
+
(defun sit-for (seconds &optional nodisp obsolete)
"Perform redisplay, then wait for SECONDS seconds or until input is available.
SECONDS may be a floating-point value.
(setq read (cons t read)))
(push read unread-command-events)
nil))))))
-(set-advertised-calling-convention 'sit-for '(seconds &optional nodisp))
+(set-advertised-calling-convention 'sit-for '(seconds &optional nodisp) "22.1")
+
+(defun y-or-n-p (prompt &rest args)
+ "Ask user a \"y or n\" question. Return t if answer is \"y\".
+The string to display to ask the question is obtained by
+formatting the string PROMPT with arguments ARGS (see `format').
+The result should end in a space; `y-or-n-p' adds \"(y or n) \"
+to it.
+
+No confirmation of the answer is requested; a single character is enough.
+Also accepts Space to mean yes, or Delete to mean no. \(Actually, it uses
+the bindings in `query-replace-map'; see the documentation of that variable
+for more information. In this case, the useful bindings are `act', `skip',
+`recenter', and `quit'.\)
+
+Under a windowing system a dialog box will be used if `last-nonmenu-event'
+is nil and `use-dialog-box' is non-nil."
+ ;; ¡Beware! when I tried to edebug this code, Emacs got into a weird state
+ ;; where all the keys were unbound (i.e. it somehow got triggered
+ ;; within read-key, apparently). I had to kill it.
+ (let ((answer 'recenter))
+ (if (and (display-popup-menus-p)
+ (listp last-nonmenu-event)
+ use-dialog-box)
+ (setq answer
+ (x-popup-dialog t `(,prompt ("yes" . act) ("No" . skip))))
+ (setq prompt (concat (apply 'format prompt args)
+ (if (eq ?\s (aref prompt (1- (length prompt))))
+ "" " ")
+ "(y or n) "))
+ (while
+ (let* ((key
+ (let ((cursor-in-echo-area t))
+ (when minibuffer-auto-raise
+ (raise-frame (window-frame (minibuffer-window))))
+ (read-key (propertize (if (eq answer 'recenter)
+ prompt
+ (concat "Please answer y or n. "
+ prompt))
+ 'face 'minibuffer-prompt)))))
+ (setq answer (lookup-key query-replace-map (vector key) t))
+ (cond
+ ((memq answer '(skip act)) nil)
+ ((eq answer 'recenter) (recenter) t)
+ ((memq answer '(exit-prefix quit)) (signal 'quit nil) t)
+ (t t)))
+ (ding)
+ (discard-input)))
+ (let ((ret (eq answer 'act)))
+ (unless noninteractive
+ (message "%s %s" prompt (if ret "y" "n")))
+ ret)))
+
\f
;;; Atomic change groups.
(recenter (/ (window-height) 2))))
(message (or message "Type %s to continue editing.")
(single-key-description exit-char))
- (let (char)
- (if (integerp exit-char)
- (condition-case nil
- (progn
- (setq char (read-char))
- (or (eq char exit-char)
- (setq unread-command-events (list char))))
- (error
- ;; `exit-char' is a character, hence it differs
- ;; from char, which is an event.
- (setq unread-command-events (list char))))
- ;; `exit-char' can be an event, or an event description list.
- (setq char (read-event))
- (or (eq char exit-char)
- (eq char (event-convert-list exit-char))
- (setq unread-command-events (list char))))))
+ (let ((event (read-event)))
+ ;; `exit-char' can be an event, or an event description list.
+ (or (eq event exit-char)
+ (eq event (event-convert-list exit-char))
+ (setq unread-command-events (list event)))))
(delete-overlay ol))))
\f
(or (stringp object) (null object)))
(defun booleanp (object)
- "Return non-nil if OBJECT is one of the two canonical boolean values: t or nil."
- (memq object '(nil t)))
+ "Return t if OBJECT is one of the two canonical boolean values: t or nil.
+Otherwise, return nil."
+ (and (memq object '(nil t)) t))
(defun field-at-pos (pos)
"Return the field at position POS, taking stickiness etc into account."
(defvar yank-undo-function)
(defun insert-for-yank (string)
- "Calls `insert-for-yank-1' repetitively for each `yank-handler' segment.
+ "Call `insert-for-yank-1' repetitively for each `yank-handler' segment.
See `insert-for-yank-1' for more details."
(let (to)
`yank-rectangle', PARAM may be a list of strings to insert as a
rectangle.
If NOEXCLUDE is present and non-nil, the normal removal of the
- yank-excluded-properties is not performed; instead FUNCTION is
+ `yank-excluded-properties' is not performed; instead FUNCTION is
responsible for removing those properties. This may be necessary
if FUNCTION adjusts point before or after inserting the object.
If UNDO is present and non-nil, it is a function that will be called
(start-process name buffer shell-file-name shell-command-switch
(mapconcat 'identity args " ")))
(set-advertised-calling-convention 'start-process-shell-command
- '(name buffer command))
+ '(name buffer command) "23.1")
(defun start-file-process-shell-command (name buffer &rest args)
"Start a program in a subprocess. Return the process object for it.
(if (file-remote-p default-directory) "-c" shell-command-switch)
(mapconcat 'identity args " ")))
(set-advertised-calling-convention 'start-file-process-shell-command
- '(name buffer command))
+ '(name buffer command) "23.1")
(defun call-process-shell-command (command &optional infile buffer display
&rest args)
"Create a new buffer, evaluate BODY there, and write the buffer to FILE.
The value returned is the value of the last form in BODY.
See also `with-temp-buffer'."
- (declare (debug t))
+ (declare (indent 1) (debug t))
(let ((temp-file (make-symbol "temp-file"))
(temp-buffer (make-symbol "temp-buffer")))
`(let ((,temp-file ,file)
MESSAGE is written to the message log buffer if `message-log-max' is non-nil.
If MESSAGE is nil, the echo area and message log buffer are unchanged.
Use a MESSAGE of \"\" to temporarily clear the echo area."
- (declare (debug t))
+ (declare (debug t) (indent 1))
(let ((current-message (make-symbol "current-message"))
(temp-message (make-symbol "with-temp-message")))
`(let ((,temp-message ,message)
(kill-buffer ,temp-buffer)))))))
(defmacro with-silent-modifications (&rest body)
- "Execute BODY, pretending it does not modifies the buffer.
+ "Execute BODY, pretending it does not modify the buffer.
If BODY performs real modifications to the buffer's text, other
than cosmetic ones, undo data may become corrupted.
Typically used around modifications of text-properties which do not really
(let ((err (make-symbol "err")))
`(condition-case-no-debug ,err
(progn ,@body)
- (error (message "Error: %s" ,err) nil))))
+ (error (message "Error: %S" ,err) nil))))
(defmacro combine-after-change-calls (&rest body)
"Execute BODY, but don't call the after-change functions till the end.
REP is either a string used as the NEWTEXT arg of `replace-match' or a
function. If it is a function, it is called with the actual text of each
match, and its value is used as the replacement text. When REP is called,
-the match-data are the result of matching REGEXP against a substring
+the match data are the result of matching REGEXP against a substring
of STRING.
To replace only the first match (if any), make REGEXP match up to \\'
The syntax table of the current buffer is saved, BODY is evaluated, and the
saved table is restored, even in case of an abnormal exit.
Value is what BODY returns."
- (declare (debug t))
+ (declare (debug t) (indent 1))
(let ((old-table (make-symbol "table"))
(old-buffer (make-symbol "buffer")))
`(let ((,old-table (syntax-table))
;;;; Comparing version strings.
(defconst version-separator "."
- "*Specify the string used to separate the version elements.
+ "Specify the string used to separate the version elements.
Usually the separator is \".\", but it can be any other string.")
(defconst version-regexp-alist
- '(("^[-_+ ]?a\\(lpha\\)?$" . -3)
- ("^[-_+]$" . -3) ; treat "1.2.3-20050920" and "1.2-3" as alpha releases
- ("^[-_+ ]cvs$" . -3) ; treat "1.2.3-CVS" as alpha release
- ("^[-_+ ]?b\\(eta\\)?$" . -2)
- ("^[-_+ ]?\\(pre\\|rc\\)$" . -1))
- "*Specify association between non-numeric version part and a priority.
+ '(("^[-_+ ]?alpha$" . -3)
+ ("^[-_+]$" . -3) ; treat "1.2.3-20050920" and "1.2-3" as alpha releases
+ ("^[-_+ ]cvs$" . -3) ; treat "1.2.3-CVS" as alpha release
+ ("^[-_+ ]?beta$" . -2)
+ ("^[-_+ ]?\\(pre\\|rcc\\)$" . -1))
+ "Specify association between non-numeric version and its priority.
This association is used to handle version string like \"1.0pre2\",
\"0.9alpha1\", etc. It's used by `version-to-list' (which see) to convert the
-non-numeric part to an integer. For example:
+non-numeric part of a version string to an integer. For example:
String Version Integer List Version
\"1.0pre2\" (1 0 -1 2)
Where:
REGEXP regexp used to match non-numeric part of a version string.
- It should begin with a `^' anchor and end with a `$' to
+ It should begin with the `^' anchor and end with a `$' to
prevent false hits. Letter-case is ignored while matching
REGEXP.
-PRIORITY negative integer which indicate the non-numeric priority.")
+PRIORITY a negative integer specifying non-numeric priority of REGEXP.")
(defun version-to-list (ver)
- "Convert version string VER into an integer list.
+ "Convert version string VER into a list of integers.
The version syntax is given by the following EBNF:
The NUMBER part is optional if SEPARATOR is a match for an element
in `version-regexp-alist'.
-As an example of valid version syntax:
+Examples of valid version syntax:
1.0pre2 1.0.7.5 22.8beta3 0.9alpha1 6.9.30Beta
-As an example of invalid version syntax:
+Examples of invalid version syntax:
1.0prepre2 1.0..7.5 22.8X3 alpha3.2 .5
-As an example of version convertion:
+Examples of version conversion:
- String Version Integer List Version
+ Version String Version as a List of Integers
\"1.0.7.5\" (1 0 7 5)
\"1.0pre2\" (1 0 -1 2)
\"1.0PRE2\" (1 0 -1 2)
(setq al version-regexp-alist)
(while (and al (not (string-match (caar al) s)))
(setq al (cdr al)))
- (or al (error "Invalid version syntax: '%s'" ver))
- (setq lst (cons (cdar al) lst)))))
+ (cond (al
+ (push (cdar al) lst))
+ ;; Convert 22.3a to 22.3.1, 22.3b to 22.3.2, etc.
+ ((string-match "^[-_+ ]?\\([a-zA-Z]\\)$" s)
+ (push (- (aref (downcase (match-string 1 s)) 0) ?a -1)
+ lst))
+ (t (error "Invalid version syntax: '%s'" ver))))))
(if (null lst)
(error "Invalid version syntax: '%s'" ver)
(nreverse lst)))))
(defun version-list-< (l1 l2)
- "Return t if integer list L1 is lesser than L2.
+ "Return t if L1, a list specification of a version, is lower than L2.
-Note that integer list (1) is equal to (1 0), (1 0 0), (1 0 0 0),
-etc. That is, the trailing zeroes are irrelevant. Also, integer
-list (1) is greater than (1 -1) which is greater than (1 -2)
-which is greater than (1 -3)."
+Note that a version specified by the list (1) is equal to (1 0),
+\(1 0 0), (1 0 0 0), etc. That is, the trailing zeros are insignificant.
+Also, a version given by the list (1) is higher than (1 -1), which in
+turn is higher than (1 -2), which is higher than (1 -3)."
(while (and l1 l2 (= (car l1) (car l2)))
(setq l1 (cdr l1)
l2 (cdr l2)))
(defun version-list-= (l1 l2)
- "Return t if integer list L1 is equal to L2.
+ "Return t if L1, a list specification of a version, is equal to L2.
-Note that integer list (1) is equal to (1 0), (1 0 0), (1 0 0 0),
-etc. That is, the trailing zeroes are irrelevant. Also, integer
-list (1) is greater than (1 -1) which is greater than (1 -2)
-which is greater than (1 -3)."
+Note that a version specified by the list (1) is equal to (1 0),
+\(1 0 0), (1 0 0 0), etc. That is, the trailing zeros are insignificant.
+Also, a version given by the list (1) is higher than (1 -1), which in
+turn is higher than (1 -2), which is higher than (1 -3)."
(while (and l1 l2 (= (car l1) (car l2)))
(setq l1 (cdr l1)
l2 (cdr l2)))
(defun version-list-<= (l1 l2)
- "Return t if integer list L1 is lesser than or equal to L2.
+ "Return t if L1, a list specification of a version, is lower or equal to L2.
Note that integer list (1) is equal to (1 0), (1 0 0), (1 0 0 0),
-etc. That is, the trailing zeroes are irrelevant. Also, integer
+etc. That is, the trailing zeroes are insignificant. Also, integer
list (1) is greater than (1 -1) which is greater than (1 -2)
which is greater than (1 -3)."
(while (and l1 l2 (= (car l1) (car l2)))
(t (<= 0 (version-list-not-zero l2)))))
(defun version-list-not-zero (lst)
- "Return the first non-zero element of integer list LST.
+ "Return the first non-zero element of LST, which is a list of integers.
-If all LST elements are zeroes or LST is nil, return zero."
+If all LST elements are zeros or LST is nil, return zero."
(while (and lst (zerop (car lst)))
(setq lst (cdr lst)))
(if lst
(defun version< (v1 v2)
- "Return t if version V1 is lesser than V2.
+ "Return t if version V1 is lower (older) than V2.
Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\",
-etc. That is, the trailing \".0\"s are irrelevant. Also, version string \"1\"
-is greater than \"1pre\" which is greater than \"1beta\" which is greater than
-\"1alpha\"."
+etc. That is, the trailing \".0\"s are insignificant. Also, version
+string \"1\" is higher (newer) than \"1pre\", which is higher than \"1beta\",
+which is higher than \"1alpha\"."
(version-list-< (version-to-list v1) (version-to-list v2)))
(defun version<= (v1 v2)
- "Return t if version V1 is lesser than or equal to V2.
+ "Return t if version V1 is lower (older) than or equal to V2.
Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\",
-etc. That is, the trailing \".0\"s are irrelevant. Also, version string \"1\"
-is greater than \"1pre\" which is greater than \"1beta\" which is greater than
-\"1alpha\"."
+etc. That is, the trailing \".0\"s are insignificant. Also, version
+string \"1\" is higher (newer) than \"1pre\", which is higher than \"1beta\",
+which is higher than \"1alpha\"."
(version-list-<= (version-to-list v1) (version-to-list v2)))
(defun version= (v1 v2)
"Return t if version V1 is equal to V2.
Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\",
-etc. That is, the trailing \".0\"s are irrelevant. Also, version string \"1\"
-is greater than \"1pre\" which is greater than \"1beta\" which is greater than
-\"1alpha\"."
+etc. That is, the trailing \".0\"s are insignificant. Also, version
+string \"1\" is higher (newer) than \"1pre\", which is higher than \"1beta\",
+which is higher than \"1alpha\"."
(version-list-= (version-to-list v1) (version-to-list v2)))
\f
;; The following statement ought to be in print.c, but `provide' can't
;; be used there.
+;; http://lists.gnu.org/archive/html/emacs-devel/2009-08/msg00236.html
(when (hash-table-p (car (read-from-string
(prin1-to-string (make-hash-table)))))
(provide 'hashtable-print-readable))
-;; arch-tag: f7e0e6e5-70aa-4897-ae72-7a3511ec40bc
;;; subr.el ends here
HCoop / bpt / emacs.git / blobdiff