APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1336239720 -3600
# Node ID b7ae5f44b95017d6cee969e8353e73eb16a62f01
# Parent ddf56c45634e53e4b1cdfd4777a53c95f6501fb5
Remove some redundant functions, change others to labels, lisp/
lisp/ChangeLog addition:
2012-05-05 Aidan Kehoe <kehoea(a)parhasard.net>
Remove some redundant functions; turn other utility functions into
labels, avoiding visibility in the global namespace, and reducing
the size of the dumped binary.
* auto-save.el (auto-save-unhex): Removed.
* auto-save.el (auto-save-unescape-name): Use #'string-to-number
instead of #'auto-save-unhex.
* files.el (save-some-buffers):
* files.el (save-some-buffers-1): Changed to a label.
* files.el (not-modified):
* gui.el (make-gui-button):
* gui.el (gui-button-action): Changed to a label.
* gui.el (insert-gui-button):
* indent.el (indent-for-tab-command):
* indent.el (insert-tab): Changed to a label.
* indent.el (indent-rigidly):
* isearch-mode.el:
* isearch-mode.el (isearch-ring-adjust):
* isearch-mode.el (isearch-ring-adjust1): Changed to a label.
* isearch-mode.el (isearch-pre-command-hook):
* isearch-mode.el (isearch-maybe-frob-keyboard-macros): Changed to
a label.
* isearch-mode.el (isearch-highlight):
* isearch-mode.el (isearch-make-extent): Changed to a label.
* itimer.el:
* itimer.el (itimer-decrement): Removed, replaced uses with decf.
* itimer.el (itimer-increment): Removed, replaced uses with incf.
* itimer.el (itimer-signum): Removed, replaced uses with minusp, plusp.
* itimer.el (itimer-name):
* itimer.el (check-itimer): Removed, replaced with #'check-type calls.
* itimer.el (itimer-value):
* itimer.el (check-itimer-coerce-string): Removed.
* itimer.el (itimer-restart):
* itimer.el (itimer-function):
* itimer.el (check-nonnegative-number): Removed.
* itimer.el (itimer-uses-arguments):
* itimer.el (check-string): Removed.
* itimer.el (itimer-function-arguments):
* itimer.el (itimer-recorded-run-time):
* itimer.el (set-itimer-name):
* itimer.el (set-itimer-value):
* itimer.el (set-itimer-value-internal):
* itimer.el (set-itimer-restart):
* itimer.el (set-itimer-function):
* itimer.el (set-itimer-is-idle):
* itimer.el (set-itimer-recorded-run-time):
* itimer.el (get-itimer):
* itimer.el (delete-itimer):
* itimer.el (start-itimer):
* itimer.el (activate-itimer):
* itimer.el (itimer-edit-set-field):
* itimer.el (itimer-edit-next-field):
* itimer.el (itimer-edit-previous-field):
Use incf, decf, plusp, minusp and the more general argument type
checking macros.
* lib-complete.el:
* lib-complete.el (lib-complete:better-root): Changed to a label.
* lib-complete.el (lib-complete:get-completion-table): Changed to
a label.
* lib-complete.el (read-library-internal): Include labels.
* lib-complete.el (lib-complete:cache-completions): Changed to a
label.
* minibuf.el (read-buffer): Use #'set-difference, don't reinvent it.
* newcomment.el (comment-padright): Use a label instead of
repeating a lambda expression.
* packages.el (package-get-key):
* packages.el (package-get-key-1): Removed, use #'getf instead.
* simple.el (kill-backward-chars): Removed; this isn't used.
* simple.el (what-cursor-position):
(lambda (arg) (format "%S" arg) -> #'prin1-to-string.
* simple.el (debug-print-1): Renamed to #'debug-print.
* simple.el (debug-print): Removed, #'debug-print-1 was equivalent.
* subr.el (integer-to-bit-vector): check-nonnegative-number no
longer available.
* widget.el (define-widget):
* widget.el (define-widget-keywords): Removed, this was long obsolete.
diff -r ddf56c45634e -r b7ae5f44b950 lisp/ChangeLog
--- a/lisp/ChangeLog Fri May 04 21:12:51 2012 +0100
+++ b/lisp/ChangeLog Sat May 05 18:42:00 2012 +0100
@@ -1,3 +1,82 @@
+2012-05-05 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ Remove some redundant functions; turn other utility functions into
+ labels, avoiding visibility in the global namespace, and reducing
+ the size of the dumped binary.
+
+ * auto-save.el (auto-save-unhex): Removed.
+ * auto-save.el (auto-save-unescape-name): Use #'string-to-number
+ instead of #'auto-save-unhex.
+ * files.el (save-some-buffers):
+ * files.el (save-some-buffers-1): Changed to a label.
+ * files.el (not-modified):
+ * gui.el (make-gui-button):
+ * gui.el (gui-button-action): Changed to a label.
+ * gui.el (insert-gui-button):
+ * indent.el (indent-for-tab-command):
+ * indent.el (insert-tab): Changed to a label.
+ * indent.el (indent-rigidly):
+ * isearch-mode.el:
+ * isearch-mode.el (isearch-ring-adjust):
+ * isearch-mode.el (isearch-ring-adjust1): Changed to a label.
+ * isearch-mode.el (isearch-pre-command-hook):
+ * isearch-mode.el (isearch-maybe-frob-keyboard-macros): Changed to
+ a label.
+ * isearch-mode.el (isearch-highlight):
+ * isearch-mode.el (isearch-make-extent): Changed to a label.
+ * itimer.el:
+ * itimer.el (itimer-decrement): Removed, replaced uses with decf.
+ * itimer.el (itimer-increment): Removed, replaced uses with incf.
+ * itimer.el (itimer-signum): Removed, replaced uses with minusp, plusp.
+ * itimer.el (itimer-name):
+ * itimer.el (check-itimer): Removed, replaced with #'check-type calls.
+ * itimer.el (itimer-value):
+ * itimer.el (check-itimer-coerce-string): Removed.
+ * itimer.el (itimer-restart):
+ * itimer.el (itimer-function):
+ * itimer.el (check-nonnegative-number): Removed.
+ * itimer.el (itimer-uses-arguments):
+ * itimer.el (check-string): Removed.
+ * itimer.el (itimer-function-arguments):
+ * itimer.el (itimer-recorded-run-time):
+ * itimer.el (set-itimer-name):
+ * itimer.el (set-itimer-value):
+ * itimer.el (set-itimer-value-internal):
+ * itimer.el (set-itimer-restart):
+ * itimer.el (set-itimer-function):
+ * itimer.el (set-itimer-is-idle):
+ * itimer.el (set-itimer-recorded-run-time):
+ * itimer.el (get-itimer):
+ * itimer.el (delete-itimer):
+ * itimer.el (start-itimer):
+ * itimer.el (activate-itimer):
+ * itimer.el (itimer-edit-set-field):
+ * itimer.el (itimer-edit-next-field):
+ * itimer.el (itimer-edit-previous-field):
+ Use incf, decf, plusp, minusp and the more general argument type
+ checking macros.
+ * lib-complete.el:
+ * lib-complete.el (lib-complete:better-root): Changed to a label.
+ * lib-complete.el (lib-complete:get-completion-table): Changed to
+ a label.
+ * lib-complete.el (read-library-internal): Include labels.
+ * lib-complete.el (lib-complete:cache-completions): Changed to a
+ label.
+ * minibuf.el (read-buffer): Use #'set-difference, don't reinvent it.
+ * newcomment.el (comment-padright): Use a label instead of
+ repeating a lambda expression.
+ * packages.el (package-get-key):
+ * packages.el (package-get-key-1): Removed, use #'getf instead.
+ * simple.el (kill-backward-chars): Removed; this isn't used.
+ * simple.el (what-cursor-position):
+ (lambda (arg) (format "%S" arg) -> #'prin1-to-string.
+ * simple.el (debug-print-1): Renamed to #'debug-print.
+ * simple.el (debug-print): Removed, #'debug-print-1 was equivalent.
+ * subr.el (integer-to-bit-vector): check-nonnegative-number no
+ longer available.
+ * widget.el (define-widget):
+ * widget.el (define-widget-keywords): Removed, this was long obsolete.
+
2012-05-01 Aidan Kehoe <kehoea(a)parhasard.net>
Avoid #'delq in core code, for the sake of style and a (very
diff -r ddf56c45634e -r b7ae5f44b950 lisp/auto-save.el
--- a/lisp/auto-save.el Fri May 04 21:12:51 2012 +0100
+++ b/lisp/auto-save.el Sat May 05 18:42:00 2012 +0100
@@ -412,24 +412,15 @@
(char-to-string char))))
str ""))
-(defun auto-save-unhex (x)
- (if (> x ?9)
- (if (>= x ?a)
- (+ 10 (- x ?a))
- (+ 10 (- x ?A)))
- (- x ?0)))
-
(defun auto-save-unescape-name (str)
"Undo any escaping of evil nasty characters in a file name.
See `auto-save-escape-name'."
(setq str (or str ""))
(let ((tmp "")
(case-fold-search t))
- (while (string-match "=[0-9a-f][0-9a-f]" str)
+ (while (string-match #r"=\([0-9a-f][0-9a-f]\)" str)
(let* ((start (match-beginning 0))
- (ch1 (auto-save-unhex (elt str (+ start 1))))
- (code (+ (* 16 ch1)
- (auto-save-unhex (elt str (+ start 2))))))
+ (code (string-to-number (match-string 1 str) 16)))
(setq tmp (concat tmp (substring str 0 start)
(char-to-string code))
str (substring str (match-end 0)))))
diff -r ddf56c45634e -r b7ae5f44b950 lisp/files.el
--- a/lisp/files.el Fri May 04 21:12:51 2012 +0100
+++ b/lisp/files.el Sat May 05 18:42:00 2012 +0100
@@ -3175,85 +3175,88 @@
If PRED is a zero-argument function, it indicates for each buffer whether
to consider it or not when called with that buffer current."
(interactive "P")
- (save-excursion
- ;; `delete-other-windows' can bomb during autoloads generation, so
- ;; guard it well.
- (if (or noninteractive
- (eq (selected-window) (minibuffer-window))
- (not save-some-buffers-query-display-buffer))
- ;; If playing with windows is unsafe or undesired, just do the
- ;; usual drill.
- (save-some-buffers-1 arg pred nil)
- ;; Else, protect the windows.
- (when (save-window-excursion
- (save-some-buffers-1 arg pred t))
- ;; Force redisplay.
- (sit-for 0)))))
-
-;; XEmacs - do not use queried flag
-(defun save-some-buffers-1 (arg pred switch-buffer)
- (let* ((switched nil)
- (last-buffer nil)
- (files-done
- (map-y-or-n-p
- (lambda (buffer)
- (prog1
- (and (buffer-modified-p buffer)
- (not (buffer-base-buffer buffer))
- ;; XEmacs addition:
- (not (symbol-value-in-buffer 'save-buffers-skip buffer))
- (or
- (buffer-file-name buffer)
- (and pred
- (progn
- (set-buffer buffer)
- (and buffer-offer-save (> (buffer-size) 0)))))
- (or (not (functionp pred))
- (with-current-buffer buffer (funcall pred)))
- (if arg
- t
- ;; #### We should provide a per-buffer means to
- ;; disable the switching. For instance, you might
- ;; want to turn it off for buffers the contents of
- ;; which is meaningless to humans, such as
- ;; `.newsrc.eld'.
- (when (and switch-buffer
- ;; map-y-or-n-p is displaying help
- (not (eq last-buffer buffer)))
- (unless (one-window-p)
- (delete-other-windows))
- (setq switched t)
- ;; #### Consider using `display-buffer' here for 21.1!
- ;;(display-buffer buffer nil (selected-frame)))
- (switch-to-buffer buffer t))
- (if (buffer-file-name buffer)
- (format "Save file %s? "
- (buffer-file-name buffer))
- (format "Save buffer %s? "
- (buffer-name buffer)))))
- (setq last-buffer buffer)))
- (lambda (buffer)
- (set-buffer buffer)
- (condition-case ()
- (save-buffer)
- (error nil)))
- (buffer-list)
- '("buffer" "buffers" "save")
- save-some-buffers-action-alist))
- (abbrevs-done
- (and save-abbrevs abbrevs-changed
- (progn
- (if (or arg
- (eq save-abbrevs 'silently)
- (y-or-n-p (format "Save abbrevs in %s? " abbrev-file-name)))
- (write-abbrev-file nil))
- ;; Don't keep bothering user if he says no.
- (setq abbrevs-changed nil)
- t))))
- (or (> files-done 0) abbrevs-done
- (display-message 'no-log "(No files need saving)"))
- switched))
-
+ (labels
+ ;; XEmacs - do not use queried flag, make this function a label.
+ ((save-some-buffers-1 (arg pred switch-buffer)
+ (let* ((switched nil)
+ (last-buffer nil)
+ (files-done
+ (map-y-or-n-p
+ (lambda (buffer)
+ (prog1
+ (and (buffer-modified-p buffer)
+ (not (buffer-base-buffer buffer))
+ ;; XEmacs addition:
+ (not (symbol-value-in-buffer
+ 'save-buffers-skip buffer))
+ (or
+ (buffer-file-name buffer)
+ (and pred
+ (progn
+ (set-buffer buffer)
+ (and buffer-offer-save (> (buffer-size)
+ 0)))))
+ (or (not (functionp pred))
+ (with-current-buffer buffer (funcall pred)))
+ (if arg
+ t
+ ;; #### We should provide a per-buffer means
+ ;; to disable the switching. For instance,
+ ;; you might want to turn it off for buffers
+ ;; the contents of which is meaningless to
+ ;; humans, such as `.newsrc.eld'.
+ (when (and switch-buffer
+ ;; map-y-or-n-p is displaying help
+ (not (eq last-buffer buffer)))
+ (unless (one-window-p)
+ (delete-other-windows))
+ (setq switched t)
+ ;; #### Consider using `display-buffer'
+ ;; here for 21.1!
+ ;;(display-buffer buffer nil (selected-frame)))
+ (switch-to-buffer buffer t))
+ (if (buffer-file-name buffer)
+ (format "Save file %s? "
+ (buffer-file-name buffer))
+ (format "Save buffer %s? "
+ (buffer-name buffer)))))
+ (setq last-buffer buffer)))
+ (lambda (buffer)
+ (set-buffer buffer)
+ (condition-case ()
+ (save-buffer)
+ (error nil)))
+ (buffer-list)
+ '("buffer" "buffers" "save")
+ save-some-buffers-action-alist))
+ (abbrevs-done
+ (and save-abbrevs abbrevs-changed
+ (progn
+ (if (or arg
+ (eq save-abbrevs 'silently)
+ (y-or-n-p (format "Save abbrevs in %s? "
+ abbrev-file-name)))
+ (write-abbrev-file nil))
+ ;; Don't keep bothering user if he says no.
+ (setq abbrevs-changed nil)
+ t))))
+ (or (> files-done 0) abbrevs-done
+ (display-message 'no-log "(No files need saving)"))
+ switched)))
+ (save-excursion
+ ;; `delete-other-windows' can bomb during autoloads generation, so
+ ;; guard it well.
+ (if (or noninteractive
+ (eq (selected-window) (minibuffer-window))
+ (not save-some-buffers-query-display-buffer))
+ ;; If playing with windows is unsafe or undesired, just do the
+ ;; usual drill.
+ (save-some-buffers-1 arg pred nil)
+ ;; Else, protect the windows.
+ (when (save-window-excursion
+ (save-some-buffers-1 arg pred t))
+ ;; Force redisplay.
+ (sit-for 0))))))
(defun not-modified (&optional arg)
diff -r ddf56c45634e -r b7ae5f44b950 lisp/gui.el
--- a/lisp/gui.el Fri May 04 21:12:51 2012 +0100
+++ b/lisp/gui.el Sat May 05 18:42:00 2012 +0100
@@ -91,24 +91,24 @@
(set-face-foreground 'gui-button-face '(((win color) .
"black")))))
-(defun gui-button-action (instance action user-data)
- (let ((domain (image-instance-domain instance)))
- (with-current-buffer (if (windowp domain)
- (window-buffer domain) nil)
- (funcall action user-data))))
-
(defun make-gui-button (string &optional action user-data)
"Make a GUI button whose label is STRING and whose action is ACTION.
If the button is inserted in a buffer and then clicked on, and ACTION
is non-nil, ACTION will be called with one argument, USER-DATA.
When ACTION is called, the buffer containing the button is made current."
- (vector 'button
- :descriptor string
- :face 'gui-button-face
- :callback-ex `(lambda (image-instance event)
- (gui-button-action image-instance
- (quote ,action)
- (quote ,user-data)))))
+ (labels
+ ((gui-button-action (instance action user-data)
+ (let ((domain (image-instance-domain instance)))
+ (with-current-buffer (if (windowp domain)
+ (window-buffer domain) nil)
+ (funcall action user-data)))))
+ (vector 'button
+:descriptor string
+:face 'gui-button-face
+:callback-ex `(lambda (image-instance event)
+ (gui-button-action image-instance
+ (quote ,action)
+ (quote ,user-data))))))
(defun insert-gui-button (button &optional pos buffer)
"Insert GUI button BUTTON at POS in BUFFER."
diff -r ddf56c45634e -r b7ae5f44b950 lisp/indent.el
--- a/lisp/indent.el Fri May 04 21:12:51 2012 +0100
+++ b/lisp/indent.el Sat May 05 18:42:00 2012 +0100
@@ -48,20 +48,20 @@
(defun indent-for-tab-command (&optional prefix-arg)
"Indent line in proper way for current major mode."
(interactive "P")
- (if (eq indent-line-function 'indent-to-left-margin)
- (insert-tab prefix-arg)
- (if prefix-arg
- (funcall indent-line-function prefix-arg)
- (funcall indent-line-function))))
-
-(defun insert-tab (&optional prefix-arg)
- (let ((count (prefix-numeric-value prefix-arg)))
- (if abbrev-mode
- (expand-abbrev))
- (if indent-tabs-mode
- (insert-char ?\t count)
- ;; XEmacs: (Need the `1+')
- (indent-to (* tab-width (1+ (/ (current-column) tab-width)))))))
+ (labels
+ ((insert-tab (&optional prefix-arg)
+ (let ((count (prefix-numeric-value prefix-arg)))
+ (if abbrev-mode
+ (expand-abbrev))
+ (if indent-tabs-mode
+ (insert-char ?\t count)
+ ;; XEmacs: (Need the `1+')
+ (indent-to (* tab-width (1+ (/ (current-column) tab-width))))))))
+ (if (eq indent-line-function 'indent-to-left-margin)
+ (insert-tab prefix-arg)
+ (if prefix-arg
+ (funcall indent-line-function prefix-arg)
+ (funcall indent-line-function)))))
(defun indent-rigidly (start end count)
"Indent all lines starting in the region sideways by COUNT columns.
diff -r ddf56c45634e -r b7ae5f44b950 lisp/isearch-mode.el
--- a/lisp/isearch-mode.el Fri May 04 21:12:51 2012 +0100
+++ b/lisp/isearch-mode.el Sat May 05 18:42:00 2012 +0100
@@ -1220,38 +1220,37 @@
;;===========================================================
;; Search Ring
-(defun isearch-ring-adjust1 (advance)
- ;; Helper for isearch-ring-adjust
- (let* ((ring (if isearch-regexp regexp-search-ring search-ring))
- (length (length ring))
- (yank-pointer-name (if isearch-regexp
- 'regexp-search-ring-yank-pointer
- 'search-ring-yank-pointer))
- (yank-pointer (eval yank-pointer-name)))
- (if (zerop length)
- ()
- (set yank-pointer-name
- (setq yank-pointer
- (mod (+ (or yank-pointer 0)
- ;; XEmacs change
- (if advance -1 (if yank-pointer 1 0)))
- length)))
- (setq isearch-string (nth yank-pointer ring)
- isearch-message (mapconcat 'isearch-text-char-description
- isearch-string "")))))
-
(defun isearch-ring-adjust (advance)
;; Helper for isearch-ring-advance and isearch-ring-retreat
; (if (cdr isearch-cmds) ;; is there more than one thing on stack?
; (isearch-pop-state))
- (isearch-ring-adjust1 advance)
- (if search-ring-update
- (progn
- (isearch-search)
- (isearch-update))
- (isearch-edit-string)
- )
- (isearch-push-state))
+ (labels
+ ((isearch-ring-adjust1 (advance)
+ ;; Helper for isearch-ring-adjust
+ (let* ((ring (if isearch-regexp regexp-search-ring search-ring))
+ (length (length ring))
+ (yank-pointer-name (if isearch-regexp
+ 'regexp-search-ring-yank-pointer
+ 'search-ring-yank-pointer))
+ (yank-pointer (symbol-value yank-pointer-name)))
+ (if (zerop length)
+ ()
+ (set yank-pointer-name
+ (setq yank-pointer
+ (mod (+ (or yank-pointer 0)
+ ;; XEmacs change
+ (if advance -1 (if yank-pointer 1 0)))
+ length)))
+ (setq isearch-string (nth yank-pointer ring)
+ isearch-message (mapconcat 'isearch-text-char-description
+ isearch-string ""))))))
+ (isearch-ring-adjust1 advance)
+ (if search-ring-update
+ (progn
+ (isearch-search)
+ (isearch-update))
+ (isearch-edit-string))
+ (isearch-push-state)))
(defun isearch-ring-advance ()
"Advance to the next search string in the ring."
@@ -1582,60 +1581,70 @@
;; cases.
(setq this-command (key-binding (this-command-keys))))
(t
- (isearch-maybe-frob-keyboard-macros)
- (if (and this-command
- (symbolp this-command)
- (get this-command 'isearch-command))
- nil ; then continue.
- (isearch-done)))))
-
-(defun isearch-maybe-frob-keyboard-macros ()
- ;;
- ;; If the command about to be executed is `self-insert-command' then change
- ;; the command to `isearch-printing-char' instead, meaning add the last-
- ;; typed character to the search string.
- ;;
- ;; If `this-command' is a string or a vector (that is, a keyboard macro)
- ;; and it contains only one command, which is bound to self-insert-command,
- ;; then do the same thing as for self-inserting commands: arrange for that
- ;; character to be added to the search string. If we didn't do this, then
- ;; typing a compose sequence (a la x-compose.el) would terminate the search
- ;; and insert the character, instead of searching for that character.
- ;;
- ;; We should continue doing this, since it's pretty much the behavior one
- ;; would expect, but it will stop being so necessary once key-translation-
- ;; map exists and is used by x-compose.el and things like it, since the
- ;; translation will have been done before we see the keys.
- ;;
- (cond ((eq this-command 'self-insert-command)
- (setq this-command 'isearch-printing-char))
- ((and (or (stringp this-command) (vectorp this-command))
- (eq (key-binding this-command) 'self-insert-command))
- (setq last-command-event (character-to-event (aref this-command 0))
- last-command-char (and (stringp this-command)
- (aref this-command 0))
- this-command 'isearch-printing-char))
- ((and (null this-command)
- (eq 'key-press (event-type last-command-event))
- (current-local-map)
- (let* ((this-command-keys (this-command-keys))
- (this-command-keys (or (lookup-key function-key-map
- this-command-keys)
- this-command-keys))
- (lookup-key (lookup-key global-map this-command-keys)))
- (and (eq 'self-insert-command lookup-key)
- ;; The feature here that a modification of
- ;; last-command-event is respected is undocumented, and
- ;; only applies when this-command is nil. The design
- ;; isn't reat, and I welcome suggestions for a better
- ;; one.
- (setq last-command-event
- (find-if 'key-press-event-p this-command-keys
-:from-end t)
- last-command-char
- (event-to-character last-command-event)
- this-command 'isearch-printing-char)))))))
-
+ (labels
+ ((isearch-maybe-frob-keyboard-macros ()
+ ;; If the command about to be executed is
+ ;; `self-insert-command' then change the command to
+ ;; `isearch-printing-char' instead, meaning add the last-
+ ;; typed character to the search string.
+ ;;
+ ;; If `this-command' is a string or a vector (that is, a
+ ;; keyboard macro) and it contains only one command, which is
+ ;; bound to self-insert-command, then do the same thing as for
+ ;; self-inserting commands: arrange for that character to be
+ ;; added to the search string. If we didn't do this, then
+ ;; typing a compose sequence (a la x-compose.el) would
+ ;; terminate the search and insert the character, instead of
+ ;; searching for that character.
+ ;;
+ ;; We should continue doing this, since it's pretty much the
+ ;; behavior one would expect, but it will stop being so
+ ;; necessary once key-translation- map exists and is used by
+ ;; x-compose.el and things like it, since the translation will
+ ;; have been done before we see the keys.
+ ;;
+ (cond ((eq this-command 'self-insert-command)
+ (setq this-command 'isearch-printing-char))
+ ((and (or (stringp this-command) (vectorp this-command))
+ (eq (key-binding this-command)
+ 'self-insert-command))
+ (setq last-command-event
+ (character-to-event (aref this-command 0))
+ last-command-char (and (stringp this-command)
+ (aref this-command 0))
+ this-command 'isearch-printing-char))
+ ((and (null this-command)
+ (eq 'key-press (event-type last-command-event))
+ (current-local-map)
+ (let* ((this-command-keys (this-command-keys))
+ (this-command-keys (or (lookup-key
+ function-key-map
+ this-command-keys)
+ this-command-keys))
+ (lookup-key (lookup-key global-map
+ this-command-keys)))
+ (and (eq 'self-insert-command lookup-key)
+ ;; The feature here that a modification
+ ;; of last-command-event is respected is
+ ;; undocumented, and only applies when
+ ;; this-command is nil. The design isn't
+ ;; great, and I welcome suggestions for a
+ ;; better one.
+ (setq last-command-event
+ (find-if 'key-press-event-p
+ this-command-keys
+:from-end t)
+ last-command-char
+ (event-to-character
+ last-command-event)
+ this-command
+ 'isearch-printing-char))))))))
+ (isearch-maybe-frob-keyboard-macros)
+ (if (and this-command
+ (symbolp this-command)
+ (get this-command 'isearch-command))
+ nil ; then continue.
+ (isearch-done))))))
;;;========================================================
;;; Highlighting
@@ -1645,24 +1654,25 @@
;; this face is initialized by faces.el since isearch is preloaded.
;(make-face 'isearch)
-(defun isearch-make-extent (begin end)
- (let ((x (make-extent begin end (current-buffer))))
- ;; make the isearch extent always take precedence over any mouse-
- ;; highlighted extents we may be passing through, since isearch, being
- ;; modal, is more interesting (there's nothing they could do with a
- ;; mouse-highlighted extent while in the midst of a search anyway).
- (set-extent-priority x (+ mouse-highlight-priority 2))
- (set-extent-face x 'isearch)
- (setq isearch-extent x)))
-
(defun isearch-highlight (begin end)
- (if (null search-highlight)
- nil
- ;; make sure isearch-extent is in the current buffer
- (or (and (extentp isearch-extent)
- (extent-live-p isearch-extent))
- (isearch-make-extent begin end))
- (set-extent-endpoints isearch-extent begin end (current-buffer))))
+ (labels
+ ((isearch-make-extent (begin end)
+ (let ((x (make-extent begin end (current-buffer))))
+ ;; make the isearch extent always take precedence over any mouse-
+ ;; highlighted extents we may be passing through, since isearch,
+ ;; being modal, is more interesting (there's nothing they could do
+ ;; with a mouse-highlighted extent while in the midst of a search
+ ;; anyway).
+ (set-extent-priority x (+ mouse-highlight-priority 2))
+ (set-extent-face x 'isearch)
+ (setq isearch-extent x))))
+ (if (null search-highlight)
+ nil
+ ;; make sure isearch-extent is in the current buffer
+ (or (and (extentp isearch-extent)
+ (extent-live-p isearch-extent))
+ (isearch-make-extent begin end))
+ (set-extent-endpoints isearch-extent begin end (current-buffer)))))
;; This used to have a TOTALLY flag that also deleted the extent. I
;; don't think this is necessary any longer, as isearch-highlight can
diff -r ddf56c45634e -r b7ae5f44b950 lisp/itimer.el
--- a/lisp/itimer.el Fri May 04 21:12:51 2012 +0100
+++ b/lisp/itimer.el Sat May 05 18:42:00 2012 +0100
@@ -102,62 +102,6 @@
(defvar itimer-edit-start-marker nil)
-;; macros must come first... or byte-compile'd code will throw back its
-;; head and scream.
-
-(defmacro itimer-decrement (variable)
- (list 'setq variable (list '1- variable)))
-
-(defmacro itimer-increment (variable)
- (list 'setq variable (list '1+ variable)))
-
-(defmacro itimer-signum (n)
- (list 'if (list '> n 0) 1
- (list 'if (list 'zerop n) 0 -1)))
-
-;; Itimer access functions should behave as if they were subrs. These
-;; macros are used to check the arguments to the itimer functions and
-;; signal errors appropriately if the arguments are not valid.
-
-(defmacro check-itimer (var)
- "If VAR is not bound to an itimer, signal `wrong-type-argument'.
-This is a macro."
- (list 'setq var
- (list 'if (list 'itimerp var) var
- (list 'signal ''wrong-type-argument
- (list 'list ''itimerp var)))))
-
-(defmacro check-itimer-coerce-string (var)
- "If VAR is bound to a string, look up the itimer that it names and
-bind VAR to it. Otherwise, if VAR is not bound to an itimer, signal
-`wrong-type-argument'. This is a macro."
- (list 'setq var
- (list 'cond
- (list (list 'itimerp var) var)
- (list (list 'stringp var) (list 'get-itimer var))
- (list t (list 'signal ''wrong-type-argument
- (list 'list ''string-or-itimer-p var))))))
-
-(defmacro check-nonnegative-number (var)
- "If VAR is not bound to a number, signal `wrong-type-argument'.
-If VAR is not bound to a positive number, signal `args-out-of-range'.
-This is a macro."
- (list 'setq var
- (list 'if (list 'not (list 'numberp var))
- (list 'signal ''wrong-type-argument
- (list 'list ''natnump var))
- (list 'if (list '< var 0)
- (list 'signal ''args-out-of-range (list 'list var))
- var))))
-
-(defmacro check-string (var)
- "If VAR is not bound to a string, signal `wrong-type-argument'.
-This is a macro."
- (list 'setq var
- (list 'if (list 'stringp var) var
- (list 'signal ''wrong-type-argument
- (list 'list ''stringp var)))))
-
;; Functions to access and modify itimer attributes.
(defun itimerp (object)
@@ -173,24 +117,24 @@
(defun itimer-name (itimer)
"Return the name of ITIMER."
- (check-itimer itimer)
+ (check-type itimer itimer)
(car itimer))
(defun itimer-value (itimer)
"Return the number of seconds until ITIMER expires."
- (check-itimer itimer)
+ (check-type itimer itimer)
(nth 1 itimer))
(defun itimer-restart (itimer)
"Return the value to which ITIMER will be set at restart.
The value nil is returned if this itimer isn't set to restart."
- (check-itimer itimer)
+ (check-type itimer itimer)
(nth 2 itimer))
(defun itimer-function (itimer)
"Return the function of ITIMER.
This function is called each time ITIMER expires."
- (check-itimer itimer)
+ (check-type itimer itimer)
(nth 3 itimer))
(defun itimer-is-idle (itimer)
@@ -198,31 +142,31 @@
Normal timers expire after a set interval. Idle timers expire
only after Emacs has been idle for a specific interval. ``Idle''
means no command events have occurred within the interval."
- (check-itimer itimer)
+ (check-type itimer itimer)
(nth 4 itimer))
(defun itimer-uses-arguments (itimer)
"Return non-nil if the function of ITIMER will be called with arguments.
ITIMER's function is called with the arguments each time ITIMER expires.
The arguments themselves are retrievable with `itimer-function-arguments'."
- (check-itimer itimer)
+ (check-type itimer itimer)
(nth 5 itimer))
(defun itimer-function-arguments (itimer)
"Return the function arguments of ITIMER as a list.
ITIMER's function is called with these arguments each time ITIMER expires."
- (check-itimer itimer)
+ (check-type itimer itimer)
(nth 6 itimer))
(defun itimer-recorded-run-time (itimer)
- (check-itimer itimer)
+ (check-type itimer itimer)
(nth 7 itimer))
(defun set-itimer-name (itimer name)
"Set the name of ITIMER to be NAME.
NAME is an identifier for the itimer. It must be a string. If an active
itimer already exists with this name, an error is signaled."
- (check-string name)
+ (check-type name string)
(and (itimer-live-p itimer)
(get-itimer name)
(error "itimer named \"%s\" already existing and activated"
name))
@@ -235,8 +179,9 @@
VALUE can be a floating point number. Otherwise it
must be an integer.
Returns VALUE."
- (check-itimer itimer)
- (check-nonnegative-number value)
+ (check-type itimer itimer)
+ (check-type value number)
+ (check-argument-range value 0 nil)
(let ((inhibit-quit t))
;; If the itimer is in the active list, and under the new
;; timeout value would expire before we would normally
@@ -253,8 +198,9 @@
;; Same as set-itimer-value but does not wakeup the driver.
;; Only should be used by the drivers when processing expired timers.
(defun set-itimer-value-internal (itimer value)
- (check-itimer itimer)
- (check-nonnegative-number value)
+ (check-type itimer itimer)
+ (check-type value number)
+ (check-argument-range value 0 nil)
(setcar (cdr itimer) value))
(defun set-itimer-restart (itimer restart)
@@ -264,22 +210,24 @@
RESTART can be a floating point number. Otherwise it
must be an integer.
Returns RESTART."
- (check-itimer itimer)
- (if restart (check-nonnegative-number restart))
+ (check-type itimer itimer)
+ (when restart
+ (check-type restart number)
+ (check-argument-range restart 0 nil))
(setcar (cdr (cdr itimer)) restart))
(defun set-itimer-function (itimer function)
"Set the function of ITIMER to be FUNCTION.
FUNCTION will be called when itimer expires.
Returns FUNCTION."
- (check-itimer itimer)
+ (check-type itimer itimer)
(setcar (nthcdr 3 itimer) function))
(defun set-itimer-is-idle (itimer flag)
"Set flag that says whether ITIMER is an idle timer.
If FLAG is non-nil, then ITIMER will be considered an idle timer.
Returns FLAG."
- (check-itimer itimer)
+ (check-type itimer itimer)
(setcar (nthcdr 4 itimer) flag))
(defun set-itimer-uses-arguments (itimer flag)
@@ -287,23 +235,23 @@
If FLAG is non-nil, then the function will be called with one argument,
otherwise the function will be called with no arguments.
Returns FLAG."
- (check-itimer itimer)
+ (check-type itimer itimer)
(setcar (nthcdr 5 itimer) flag))
(defun set-itimer-function-arguments (itimer &optional arguments)
"Set the function arguments of ITIMER to be ARGUMENTS.
The function of ITIMER will be called with ARGUMENTS when itimer expires.
Returns ARGUMENTS."
- (check-itimer itimer)
+ (check-type itimer itimer)
(setcar (nthcdr 6 itimer) arguments))
(defun set-itimer-recorded-run-time (itimer time)
- (check-itimer itimer)
+ (check-type itimer itimer)
(setcar (nthcdr 7 itimer) time))
(defun get-itimer (name)
"Return itimer named NAME, or nil if there is none."
- (check-string name)
+ (check-type name string)
(assoc name itimer-list))
(defun read-itimer (prompt &optional initial-input)
@@ -315,7 +263,8 @@
(defun delete-itimer (itimer)
"Deletes ITIMER. ITIMER may be an itimer or the name of one."
- (check-itimer-coerce-string itimer)
+ (if (stringp itimer) (setq itimer (get-itimer itimer)))
+ (check-type itimer itimer)
(setq itimer-list (delete* itimer itimer-list)))
(defun start-itimer (name function value &optional restart
@@ -362,15 +311,18 @@
;; hard to imagine the user specifying these interactively
nil
nil ))
- (check-string name)
- (check-nonnegative-number value)
- (if restart (check-nonnegative-number restart))
+ (check-type name string)
+ (check-type value number)
+ (check-argument-range value 0 nil)
+ (when restart
+ (check-type restart number)
+ (check-argument-range restart 0 nil))
;; Make proposed itimer name unique if it's not already.
(let ((oname name)
(num 2))
(while (get-itimer name)
(setq name (format "%s<%d>" oname num))
- (itimer-increment num)))
+ (incf num)))
(activate-itimer (list name value restart function is-idle
with-args function-arguments (list 0 0 0)))
(car itimer-list))
@@ -387,7 +339,7 @@
"Activate ITIMER, which was previously created with `make-itimer'.
ITIMER will be added to the global list of running itimers,
its FUNCTION will be called when it expires, and so on."
- (check-itimer itimer)
+ (check-type itimer itimer)
(if (memq itimer itimer-list)
(error "itimer already activated"))
(if (not (numberp (itimer-value itimer)))
@@ -408,7 +360,7 @@
(num 1))
(while (get-itimer name)
(setq name (format "%s<%d>" oname num))
- (itimer-increment num))
+ (incf num))
(setcar itimer name))
;; signal an error if the timer's name matches an already
;; activated timer.
@@ -569,7 +521,7 @@
(while (and (>= opoint (point)) (< n 6))
(forward-sexp 2)
(backward-sexp)
- (itimer-increment n))
+ (incf n))
(cond ((eq n 1) (error "Cannot change itimer name."))
((eq n 2) 'value)
((eq n 3) 'restart)
@@ -630,7 +582,7 @@
(defun itimer-edit-next-field (count)
(interactive "p")
(itimer-edit-beginning-of-field)
- (cond ((> (itimer-signum count) 0)
+ (cond ((plusp count)
(while (not (zerop count))
(forward-sexp)
;; wrap from eob to itimer-edit-start-marker
@@ -645,8 +597,8 @@
(progn
(forward-sexp 2)
(backward-sexp)))
- (itimer-decrement count)))
- ((< (itimer-signum count) 0)
+ (decf count)))
+ ((minusp count)
(while (not (zerop count))
(backward-sexp)
;; treat fields at beginning of line as if they weren't there.
@@ -657,7 +609,7 @@
(progn
(goto-char (point-max))
(backward-sexp)))
- (itimer-increment count)))))
+ (incf count)))))
(defun itimer-edit-previous-field (count)
(interactive "p")
diff -r ddf56c45634e -r b7ae5f44b950 lisp/lib-complete.el
--- a/lisp/lib-complete.el Fri May 04 21:12:51 2012 +0100
+++ b/lisp/lib-complete.el Sat May 05 18:42:00 2012 +0100
@@ -118,90 +118,90 @@
(<root> <modtimes> <completion-table>)")
-(defun lib-complete:better-root (ROOT1 ROOT2)
- "Return non-nil if ROOT1 is a superset of ROOT2."
- (and (equal (file-name-directory ROOT1) (file-name-directory ROOT2))
- (string-match
- (concat "^" (regexp-quote (file-name-nondirectory ROOT1)))
- ROOT2)))
-
-(defun lib-complete:get-completion-table (FILE PATH FILTER)
- (let* ((subdir (file-name-directory FILE))
- (root (file-name-nondirectory FILE))
- (PATH
- (mapcar
- (function (lambda (dir) (file-name-as-directory
- (expand-file-name (or dir "")))))
- PATH))
- (key (vector PATH subdir FILTER))
- (real-dirs
- (if subdir
- (mapcar (function (lambda (dir) (concat dir subdir))) PATH)
- PATH))
- (path-modtimes
- (mapcar
- (function (lambda (fn) (if fn (nth 5 (file-attributes fn)))))
- real-dirs))
- (cache-entry (assoc key lib-complete:cache))
- (cache-records (cdr cache-entry)))
- ;; Look for cached entry
- (catch 'table
- (while cache-records
- (if (and
- (lib-complete:better-root (nth 0 (car cache-records)) root)
- (equal (nth 1 (car cache-records)) path-modtimes))
- (throw 'table (nth 2 (car cache-records))))
- (setq cache-records (cdr cache-records)))
- ;; Otherwise build completions
- (let ((completion-list
- (progn-with-message "(building completion table...)"
- (library-all-completions FILE PATH nil 'fast)))
- (completion-table (make-vector 127 0)))
- (while completion-list
- (let ((completion
- (if (or (not FILTER)
- (file-directory-p (car completion-list)))
- (car completion-list)
- (funcall FILTER (car completion-list)))))
- (if completion
- (intern completion completion-table)))
- (setq completion-list (cdr completion-list)))
- ;; Cache the completions
- (lib-complete:cache-completions key root
- path-modtimes completion-table)
- completion-table))))
-
(defvar lib-complete:max-cache-size 40
"*Maximum number of search paths which are cached.")
-(defun lib-complete:cache-completions (key root modtimes table)
- (let* ((cache-entry (assoc key lib-complete:cache))
- (cache-records (cdr cache-entry))
- (new-cache-records (list (list root modtimes table))))
- (if (not cache-entry) nil
- ;; Remove old cache entry
- (setq lib-complete:cache (delete* cache-entry lib-complete:cache))
- ;; Copy non-redundant entries from old cache entry
- (while cache-records
- (if (or (equal root (nth 0 (car cache-records)))
- (lib-complete:better-root root (nth 0 (car cache-records))))
- nil
- (setq new-cache-records
- (cons (car cache-records) new-cache-records)))
- (setq cache-records (cdr cache-records))))
- ;; Add entry to front of cache
- (setq lib-complete:cache
- (cons (cons key (nreverse new-cache-records)) lib-complete:cache))
- ;; Trim cache
- (let ((tail (nthcdr lib-complete:max-cache-size lib-complete:cache)))
- (if tail (setcdr tail nil)))))
-
;;=== Read a filename, with completion in a search path ===================
(defun read-library-internal (FILE FILTER FLAG)
"Don't call this."
;; Relies on read-library-internal-search-path being let-bound
(declare (special read-library-internal-search-path))
+ (labels
+ ((lib-complete:better-root (ROOT1 ROOT2)
+ ; Return non-nil if ROOT1 is a superset of ROOT2.
+ (and (equal (file-name-directory ROOT1) (file-name-directory ROOT2))
+ (string-match
+ (concat "^" (regexp-quote (file-name-nondirectory ROOT1)))
+ ROOT2)))
+ (lib-complete:get-completion-table (FILE PATH FILTER)
+ (let* ((subdir (file-name-directory FILE))
+ (root (file-name-nondirectory FILE))
+ (PATH
+ (mapcar
+ (function (lambda (dir) (file-name-as-directory
+ (expand-file-name (or dir "")))))
+ PATH))
+ (key (vector PATH subdir FILTER))
+ (real-dirs
+ (if subdir
+ (mapcar (function (lambda (dir) (concat dir subdir))) PATH)
+ PATH))
+ (path-modtimes
+ (mapcar
+ (function (lambda (fn) (if fn (nth 5 (file-attributes fn)))))
+ real-dirs))
+ (cache-entry (assoc key lib-complete:cache))
+ (cache-records (cdr cache-entry)))
+ ;; Look for cached entry
+ (catch 'table
+ (while cache-records
+ (if (and
+ (lib-complete:better-root (nth 0 (car cache-records)) root)
+ (equal (nth 1 (car cache-records)) path-modtimes))
+ (throw 'table (nth 2 (car cache-records))))
+ (setq cache-records (cdr cache-records)))
+ ;; Otherwise build completions
+ (let ((completion-list
+ (progn-with-message "(building completion table...)"
+ (library-all-completions FILE PATH nil 'fast)))
+ (completion-table (make-vector 127 0)))
+ (while completion-list
+ (let ((completion
+ (if (or (not FILTER)
+ (file-directory-p (car completion-list)))
+ (car completion-list)
+ (funcall FILTER (car completion-list)))))
+ (if completion
+ (intern completion completion-table)))
+ (setq completion-list (cdr completion-list)))
+ ;; Cache the completions
+ (lib-complete:cache-completions key root
+ path-modtimes completion-table)
+ completion-table))))
+ (lib-complete:cache-completions (key root modtimes table)
+ (let* ((cache-entry (assoc key lib-complete:cache))
+ (cache-records (cdr cache-entry))
+ (new-cache-records (list (list root modtimes table))))
+ (if (not cache-entry) nil
+ ;; Remove old cache entry
+ (setq lib-complete:cache (delete* cache-entry lib-complete:cache))
+ ;; Copy non-redundant entries from old cache entry
+ (while cache-records
+ (if (or (equal root (nth 0 (car cache-records)))
+ (lib-complete:better-root root
+ (nth 0 (car cache-records))))
+ nil
+ (setq new-cache-records
+ (cons (car cache-records) new-cache-records)))
+ (setq cache-records (cdr cache-records))))
+ ;; Add entry to front of cache
+ (setq lib-complete:cache
+ (cons (cons key (nreverse new-cache-records))
+ lib-complete:cache))
+ ;; Trim cache
+ (let ((tail (nthcdr lib-complete:max-cache-size lib-complete:cache)))
+ (if tail (setcdr tail nil))))))
(let ((completion-table
(lib-complete:get-completion-table
FILE read-library-internal-search-path FILTER)))
@@ -212,7 +212,7 @@
((eq FLAG nil) (try-completion FILE completion-table nil))
((eq FLAG t) (all-completions FILE completion-table nil))
((eq FLAG 'lambda) (and (intern-soft FILE completion-table) t))
- )))
+ ))))
(defun read-library (PROMPT SEARCH-PATH &optional DEFAULT MUST-MATCH
FULL FILTER)
diff -r ddf56c45634e -r b7ae5f44b950 lisp/minibuf.el
--- a/lisp/minibuf.el Fri May 04 21:12:51 2012 +0100
+++ b/lisp/minibuf.el Sat May 05 18:42:00 2012 +0100
@@ -1479,8 +1479,7 @@
default))
prompt))
(alist (mapcar #'(lambda (b) (cons (buffer-name b) b))
- (remove-if (lambda (elt) (member elt exclude))
- (buffer-list))))
+ (set-difference (buffer-list) exclude)))
result)
(while (progn
(setq result (completing-read prompt alist nil require-match
diff -r ddf56c45634e -r b7ae5f44b950 lisp/newcomment.el
--- a/lisp/newcomment.el Fri May 04 21:12:51 2012 +0100
+++ b/lisp/newcomment.el Sat May 05 18:42:00 2012 +0100
@@ -577,12 +577,14 @@
(concat lpad s (when multi (make-string n (aref str (1- (match-end 1))))) rpad)
;; construct a regexp that would match anything from just S
;; to any possible output of this function for any N.
- (concat (mapconcat (lambda (c) (concat (regexp-quote (string c)) "?"))
- lpad "") ;padding is not required
- (regexp-quote s)
- (when multi "+") ;the last char of S might be repeated
- (mapconcat (lambda (c) (concat (regexp-quote (string c)) "?"))
- rpad "")))))) ;padding is not required
+ (labels
+ ((regexp-quote-with-? (c) (concat (regexp-quote (string c)) "?")))
+ (concat (mapconcat #'regexp-quote-with-?
+ lpad "") ;padding is not required
+ (regexp-quote s)
+ (when multi "+") ;the last char of S might be repeated
+ (mapconcat #'regexp-quote-with-?
+ rpad ""))))))) ;padding is not required
(defun comment-padleft (str &optional n)
"Construct a string composed of `comment-padding' plus STR.
diff -r ddf56c45634e -r b7ae5f44b950 lisp/packages.el
--- a/lisp/packages.el Fri May 04 21:12:51 2012 +0100
+++ b/lisp/packages.el Sat May 05 18:42:00 2012 +0100
@@ -91,19 +91,9 @@
`("site-packages" ,@(when (featurep 'mule)
'("mule-packages"))
"xemacs-packages"))
-(defun package-get-key-1 (info key)
- "Locate keyword `key' in list."
- (cond ((null info)
- nil)
- ((eq (car info) key)
- (nth 1 info))
- (t (package-get-key-1 (cddr info) key))))
-
(defun package-get-key (name key)
"Get info `key' from package `name'."
- (let ((info (assq name packages-package-list)))
- (when info
- (package-get-key-1 (cdr info) key))))
+ (getf (cdr (assq name packages-package-list)) key))
(defun package-provide (name &rest attributes)
(let ((info (if (and attributes (floatp (car attributes)))
diff -r ddf56c45634e -r b7ae5f44b950 lisp/simple.el
--- a/lisp/simple.el Fri May 04 21:12:51 2012 +0100
+++ b/lisp/simple.el Sat May 05 18:42:00 2012 +0100
@@ -407,12 +407,6 @@
(if (eq arg '-) (setq arg -1))
(kill-region (point) (+ (point) arg)))
-;; Internal subroutine of backward-delete-char
-(defun kill-backward-chars (arg)
- (if (listp arg) (setq arg (car arg)))
- (if (eq arg '-) (setq arg -1))
- (kill-region (point) (- (point) arg)))
-
(defun backward-delete-char-untabify (arg &optional killp)
"Delete characters backward, changing tabs into spaces.
Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil.
@@ -824,8 +818,7 @@
percent narrowed-details col hscroll)
(message "Char: %s (%s %s) point=%d of %d(%d%%)%s column %d %s"
(text-char-description char) unicode-string
- (mapconcat (lambda (arg) (format "%S" arg))
- (split-char char) " ")
+ (mapconcat #'prin1-to-string (split-char char) " ")
pos total
percent narrowed-details col hscroll)))))
@@ -4766,8 +4759,8 @@
(cond ((featurep 'xemacs) "XEmacs")
(t "Emacs")))
-(defun debug-print-1 (&rest args)
- "Send a debugging-type string to standard output.
+(defun debug-print (&rest args)
+ "Send a string to the debugging output.
If the first argument is a string, it is considered to be a format
specifier if there are sufficient numbers of other args, and the string is
formatted using (apply #'format args). Otherwise, each argument is printed
@@ -4790,15 +4783,6 @@
(incf i))
(terpri)))))
-(defun debug-print (&rest args)
- "Send a string to the debugging output.
-If the first argument is a string, it is considered to be a format
-specifier if there are sufficient numbers of other args, and the string is
-formatted using (apply #'format args). Otherwise, each argument is printed
-individually in a numbered list."
- (let ((standard-output 'external-debugging-output))
- (apply #'debug-print-1 args)))
-
(defun debug-backtrace ()
"Send a backtrace to the debugging output."
(let ((standard-output 'external-debugging-output))
diff -r ddf56c45634e -r b7ae5f44b950 lisp/subr.el
--- a/lisp/subr.el Fri May 04 21:12:51 2012 +0100
+++ b/lisp/subr.el Sat May 05 18:42:00 2012 +0100
@@ -975,9 +975,9 @@
"Return INTEGER converted to a bit vector.
Optional argument MINLENGTH gives a minimum length for the returned vector.
If MINLENGTH is not given, zero high-order bits will be ignored."
- (check-argument-type #'integerp integer)
+ (check-type integer integer)
(setq minlength (or minlength 0))
- (check-nonnegative-number minlength)
+ (check-type minlength natnum)
(read (format (format "#*%%0%db" minlength) integer)))
;; XEmacs addition.
diff -r ddf56c45634e -r b7ae5f44b950 lisp/widget.el
--- a/lisp/widget.el Fri May 04 21:12:51 2012 +0100
+++ b/lisp/widget.el Sat May 05 18:42:00 2012 +0100
@@ -34,19 +34,6 @@
;;; Code:
-;; Neither XEmacs, nor latest GNU Emacs need this -- provided for
-;; compatibility.
-;; (defalias 'define-widget-keywords 'ignore)
-
-(defmacro define-widget-keywords (&rest keys)
- "This doesn't do anything in Emacs 20 or XEmacs."
- `(eval-and-compile
- (let ((keywords (quote ,keys)))
- (while keywords
- (or (boundp (car keywords))
- (set (car keywords) (car keywords)))
- (setq keywords (cdr keywords))))))
-
(defun define-widget (name class doc &rest args)
"Define a new widget type named NAME from CLASS.
--
‘Iodine deficiency was endemic in parts of the UK until, through what has been
described as “an unplanned and accidental public health triumph”, iodine was
added to cattle feed to improve milk production in the 1930s.’
(EN Pearce, Lancet, June 2011)
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches