Mercurial > hg > xemacs-beta
changeset 5655:b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
lisp/ChangeLog addition:
2012-05-05 Aidan Kehoe <kehoea@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.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sat, 05 May 2012 18:42:00 +0100 |
| parents | ddf56c45634e |
| children | e9c3fe82127d |
| files | lisp/ChangeLog lisp/auto-save.el lisp/files.el lisp/gui.el lisp/indent.el lisp/isearch-mode.el lisp/itimer.el lisp/lib-complete.el lisp/minibuf.el lisp/newcomment.el lisp/packages.el lisp/simple.el lisp/subr.el lisp/widget.el |
| diffstat | 14 files changed, 431 insertions(+), 434 deletions(-) [+] |
line wrap: on
line diff
--- 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@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@parhasard.net> Avoid #'delq in core code, for the sake of style and a (very
--- 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)))))
--- 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)
--- 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."
--- 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.
--- 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
--- 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")
--- 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)
--- 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
--- 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.
--- 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)))
--- 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))
--- 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.
--- 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.