;;; 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 Free Software Foundation, Inc.
+;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
(setq hook-value (list hook-value)))
;; Do the actual addition if necessary
(unless (member function hook-value)
+ (when (stringp function)
+ (setq function (purecopy function)))
(setq hook-value
(if append
(append hook-value (list function))
;; Add this FORM into after-load-alist (regardless of whether we'll be
;; evaluating it now).
(let* ((regexp-or-feature
- (if (stringp file) (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))
;; Add FORM to the element unless it's already there.
(unless (member form (cdr elt))
- (nconc elt (list form)))
+ (nconc elt (purecopy (list form))))
;; Is there an already loaded file whose name (or `provide' name)
;; matches FILE?
(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)
If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there."
(or exit-char (setq exit-char ?\s))
(let ((ol (make-overlay pos pos))
- (message (copy-sequence string)))
+ (str (copy-sequence string)))
(unwind-protect
(progn
(save-excursion
- (overlay-put ol 'after-string message)
+ (overlay-put ol 'after-string str)
(goto-char pos)
;; To avoid trouble with out-of-bounds position
(setq pos (point))
- ;; If the message end is off screen, recenter now.
+ ;; If the string end is off screen, recenter now.
(if (<= (window-end nil t) pos)
(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
(defun copy-overlay (o)
"Return a copy of overlay O."
- (let ((o1 (make-overlay (overlay-start o) (overlay-end o)
- ;; FIXME: there's no easy way to find the
- ;; insertion-type of the two markers.
- (overlay-buffer o)))
+ (let ((o1 (if (overlay-buffer o)
+ (make-overlay (overlay-start o) (overlay-end o)
+ ;; FIXME: there's no easy way to find the
+ ;; insertion-type of the two markers.
+ (overlay-buffer o))
+ (let ((o1 (make-overlay (point-min) (point-min))))
+ (delete-overlay o1)
+ o1)))
(props (overlay-properties o)))
(while props
(overlay-put o1 (pop props) (pop props)))
"Remove `yank-excluded-properties' between START and END positions.
Replaces `category' properties with their defined properties."
(let ((inhibit-read-only t))
- ;; Replace any `category' property with the properties it stands for.
+ ;; Replace any `category' property with the properties it stands
+ ;; for. This is to remove `mouse-face' properties that are placed
+ ;; on categories in *Help* buffers' buttons. See
+ ;; http://lists.gnu.org/archive/html/emacs-devel/2002-04/msg00648.html
+ ;; for the details.
(unless (memq yank-excluded-properties '(t nil))
(save-excursion
(goto-char start)
(setq matches (cons (substring string start l) matches)) ; leftover
(apply #'concat (nreverse matches)))))
\f
+(defun string-prefix-p (str1 str2 &optional ignore-case)
+ "Return non-nil if STR1 is a prefix of STR2.
+If IGNORE-CASE is non-nil, the comparison is done without paying attention
+to case differences."
+ (eq t (compare-strings str1 nil nil
+ str2 0 (length str1) ignore-case)))
+\f
;;;; invisibility specs
(defun add-to-invisibility-spec (element)
\f
;;;; Comparing version strings.
-(defvar version-separator "."
+(defconst version-separator "."
"*Specify the string used to separate the version elements.
Usually the separator is \".\", but it can be any other string.")
-(defvar version-regexp-alist
+(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.
+ "*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)
(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
(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