;;; 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
(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")
(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))
(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
;; 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 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.")
(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)))
;; The `assert' macro from the cl package signals
;; `cl-assertion-failed' at runtime so always define it.
(put 'cl-assertion-failed 'error-conditions '(error))
-(put 'cl-assertion-failed 'error-message "Assertion failed")
+(put 'cl-assertion-failed 'error-message (purecopy "Assertion failed"))
(defconst user-emacs-directory
(if (eq system-type 'ms-dos)
"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)
;; digits of precision, it doesn't really matter here. On the other
;; hand, it greatly simplifies the code.
-(defsubst progress-reporter-update (reporter value)
+(defsubst progress-reporter-update (reporter &optional value)
"Report progress of an operation in the echo area.
-However, if the change since last echo area update is too small
-or not enough time has passed, then do nothing (see
-`make-progress-reporter' for details).
-
-First parameter, REPORTER, should be the result of a call to
-`make-progress-reporter'. Second, VALUE, determines the actual
-progress of operation; it must be between MIN-VALUE and MAX-VALUE
-as passed to `make-progress-reporter'.
-
-This function is very inexpensive, you may not bother how often
-you call it."
- (when (>= value (car reporter))
- (progress-reporter-do-update reporter value)))
+REPORTER should be the result of a call to `make-progress-reporter'.
+
+If REPORTER is a numerical progress reporter---i.e. if it was
+ made using non-nil MIN-VALUE and MAX-VALUE arguments to
+ `make-progress-reporter'---then VALUE should be a number between
+ MIN-VALUE and MAX-VALUE.
-(defun make-progress-reporter (message min-value max-value
- &optional current-value
- min-change min-time)
- "Return progress reporter object to be used with `progress-reporter-update'.
-
-MESSAGE is shown in the echo area. When at least 1% of operation
-is complete, the exact percentage will be appended to the
-MESSAGE. When you call `progress-reporter-done', word \"done\"
-is printed after the MESSAGE. You can change MESSAGE of an
-existing progress reporter with `progress-reporter-force-update'.
-
-MIN-VALUE and MAX-VALUE designate starting (0% complete) and
-final (100% complete) states of operation. The latter should be
-larger; if this is not the case, then simply negate all values.
-Optional CURRENT-VALUE specifies the progress by the moment you
-call this function. You should omit it or set it to nil in most
-cases since it defaults to MIN-VALUE.
-
-Optional MIN-CHANGE determines the minimal change in percents to
-report (default is 1%.) Optional MIN-TIME specifies the minimal
-time before echo area updates (default is 0.2 seconds.) If
-`float-time' function is not present, then time is not tracked
-at all. If OS is not capable of measuring fractions of seconds,
-then this parameter is effectively rounded up."
+If REPORTER is a non-numerical reporter, VALUE should be nil.
+
+This function is relatively inexpensive. If the change since
+last update is too small or insufficient time has passed, it does
+nothing."
+ (when (or (not (numberp value)) ; For pulsing reporter
+ (>= value (car reporter))) ; For numerical reporter
+ (progress-reporter-do-update reporter value)))
+(defun make-progress-reporter (message &optional min-value max-value
+ current-value min-change min-time)
+ "Return progress reporter object for use with `progress-reporter-update'.
+
+MESSAGE is shown in the echo area, with a status indicator
+appended to the end. When you call `progress-reporter-done', the
+word \"done\" is printed after the MESSAGE. You can change the
+MESSAGE of an existing progress reporter by calling
+`progress-reporter-force-update'.
+
+MIN-VALUE and MAX-VALUE, if non-nil, are starting (0% complete)
+and final (100% complete) states of operation; the latter should
+be larger. In this case, the status message shows the percentage
+progress.
+
+If MIN-VALUE and/or MAX-VALUE is omitted or nil, the status
+message shows a \"spinning\", non-numeric indicator.
+
+Optional CURRENT-VALUE is the initial progress; the default is
+MIN-VALUE.
+Optional MIN-CHANGE is the minimal change in percents to report;
+the default is 1%.
+CURRENT-VALUE and MIN-CHANGE do not have any effect if MIN-VALUE
+and/or MAX-VALUE are nil.
+
+Optional MIN-TIME specifies the minimum interval time between
+echo area updates (default is 0.2 seconds.) If the function
+`float-time' is not present, time is not tracked at all. If the
+OS is not capable of measuring fractions of seconds, this
+parameter is effectively rounded up."
(unless min-time
(setq min-time 0.2))
(let ((reporter
- (cons min-value ;; Force a call to `message' now
+ ;; Force a call to `message' now
+ (cons (or min-value 0)
(vector (if (and (fboundp 'float-time)
(>= min-time 0.02))
(float-time) nil)
(progress-reporter-update reporter (or current-value min-value))
reporter))
-(defun progress-reporter-force-update (reporter value &optional new-message)
+(defun progress-reporter-force-update (reporter &optional value new-message)
"Report progress of an operation in the echo area unconditionally.
-First two parameters are the same as for
-`progress-reporter-update'. Optional NEW-MESSAGE allows you to
-change the displayed message."
+The first two arguments are the same as in `progress-reporter-update'.
+NEW-MESSAGE, if non-nil, sets a new message for the reporter."
(let ((parameters (cdr reporter)))
(when new-message
(aset parameters 3 new-message))
(aset parameters 0 (float-time)))
(progress-reporter-do-update reporter value)))
+(defvar progress-reporter--pulse-characters ["-" "\\" "|" "/"]
+ "Characters to use for pulsing progress reporters.")
+
(defun progress-reporter-do-update (reporter value)
(let* ((parameters (cdr reporter))
+ (update-time (aref parameters 0))
(min-value (aref parameters 1))
(max-value (aref parameters 2))
- (one-percent (/ (- max-value min-value) 100.0))
- (percentage (if (= max-value min-value)
- 0
- (truncate (/ (- value min-value) one-percent))))
- (update-time (aref parameters 0))
+ (text (aref parameters 3))
(current-time (float-time))
(enough-time-passed
;; See if enough time has passed since the last update.
(when (>= current-time update-time)
;; Calculate time for the next update
(aset parameters 0 (+ update-time (aref parameters 5)))))))
- ;;
- ;; Calculate NEXT-UPDATE-VALUE. If we are not going to print
- ;; message this time because not enough time has passed, then use
- ;; 1 instead of MIN-CHANGE. This makes delays between echo area
- ;; updates closer to MIN-TIME.
- (setcar reporter
- (min (+ min-value (* (+ percentage
- (if enough-time-passed
- (aref parameters 4) ;; MIN-CHANGE
- 1))
- one-percent))
- max-value))
- (when (integerp value)
- (setcar reporter (ceiling (car reporter))))
- ;;
- ;; Only print message if enough time has passed
- (when enough-time-passed
- (if (> percentage 0)
- (message "%s%d%%" (aref parameters 3) percentage)
- (message "%s" (aref parameters 3))))))
+ (cond ((and min-value max-value)
+ ;; Numerical indicator
+ (let* ((one-percent (/ (- max-value min-value) 100.0))
+ (percentage (if (= max-value min-value)
+ 0
+ (truncate (/ (- value min-value)
+ one-percent)))))
+ ;; Calculate NEXT-UPDATE-VALUE. If we are not printing
+ ;; message because not enough time has passed, use 1
+ ;; instead of MIN-CHANGE. This makes delays between echo
+ ;; area updates closer to MIN-TIME.
+ (setcar reporter
+ (min (+ min-value (* (+ percentage
+ (if enough-time-passed
+ ;; MIN-CHANGE
+ (aref parameters 4)
+ 1))
+ one-percent))
+ max-value))
+ (when (integerp value)
+ (setcar reporter (ceiling (car reporter))))
+ ;; Only print message if enough time has passed
+ (when enough-time-passed
+ (if (> percentage 0)
+ (message "%s%d%%" text percentage)
+ (message "%s" text)))))
+ ;; Pulsing indicator
+ (enough-time-passed
+ (let ((index (mod (1+ (car reporter)) 4))
+ (message-log-max nil))
+ (setcar reporter index)
+ (message "%s %s"
+ text
+ (aref progress-reporter--pulse-characters
+ index)))))))
(defun progress-reporter-done (reporter)
"Print reporter's message followed by word \"done\" in echo area."
\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
;;; Misc.
+(defconst menu-bar-separator '("--")
+ "Separator for menus.")
;; The following statement ought to be in print.c, but `provide' can't
;; be used there.
HCoop / bpt / emacs.git / blobdiff