Mercurial > hg > xemacs-beta
changeset 5473:ac37a5f7e5be
Merge with trunk.
line wrap: on
line diff
--- a/lisp/ChangeLog Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/ChangeLog Thu Mar 17 23:42:59 2011 +0100 @@ -1,3 +1,242 @@ +2011-03-15 Aidan Kehoe <kehoea@parhasard.net> + + * bytecomp.el: + Don't generate the old-eq, old-memq, old-equal bytecodes any more, + but keep the information about them around for the sake of the + disassembler. + +2011-03-14 Jeff Sparkes <jsparkes@gmail.com> + + * custom.el (defface): Document `min-colors' specifier. + + * faces.el (face-spec-set-match-display): Add `min-colors' + specifer for defface. + +2011-03-12 Aidan Kehoe <kehoea@parhasard.net> + + * isearch-mode.el (isearch-mode-map): + Document why we bind the ASCII characters to isearch-printing-char + in more detail. + * isearch-mode.el (isearch-maybe-frob-keyboard-macros): + If `this-command' is nil and the keys typed would normally be + bound to `self-insert-command' in the global map, force + `isearch-printing-char' to be called with an appropriate value for + last-command-event. Addresses an issue where searching for + characters generated from x-compose.el and XIM threw errors for me + in dired. + +2011-03-10 Aidan Kehoe <kehoea@parhasard.net> + + * etags.el (buffer-tag-table-list): + * files.el (find-file-read-only): + * files.el (find-file-read-only-other-window): + * info.el (Info-dir-outdated-p): + * info.el (Info-dump-dir-entries): + * info.el (Info-rebuild-dir): + * menubar-items.el (default-menubar): + * mouse.el (drag-window-divider): + * mouse.el (vertical-divider-map): + * test-harness.el (emacs-lisp-file-regexp): + Eliminate byte-compile warnings, again aside from those linked to + Stephen's various non-defined fontconfig functions. + +2011-03-10 Aidan Kehoe <kehoea@parhasard.net> + + * cmdloop.el (yes-or-no-p): + * cmdloop.el (y-or-n-p): + * descr-text.el (describe-char): + * diagnose.el (show-memory-usage): + * diagnose.el (show-object-memory-usage-stats): + * diagnose.el (show-mc-alloc-memory-usage): + * diagnose.el (show-gc-stats): + * faces.el (face-font-instance): + * gtk-font-menu.el (gtk-reset-device-font-menus): + * help.el (help-symbol-function-context-menu): + * help.el (help-symbol-variable-context-menu): + * help.el (help-symbol-function-and-variable-context-menu): + * help.el (help-find-source-or-scroll-up): + * help.el (help-mouse-find-source-or-track): + * help.el (temp-buffer-resize-mode): + * minibuf.el (mouse-read-file-name-1): + * obsolete.el (find-non-ascii-charset-string): + * obsolete.el (find-non-ascii-charset-region): + * occur.el (occur-engine): + * paragraphs.el (forward-paragraph): + * paragraphs.el (forward-sentence): + * select.el (activate-region-as-selection): + * select.el (select-make-extent-for-selection): + * simple.el (zmacs-make-extent-for-region): + Use quote, not function, for quoting symbols that may not be + fboundp at the point they are read (again, a style issue, since + Common Lisp throws an error on this, but we don't, and have no + plans to.) + +2011-03-08 Aidan Kehoe <kehoea@parhasard.net> + + * cl-macs.el: + * cl-macs.el (loop): + * cl-macs.el (cl-expand-do-loop): + * cl-macs.el (shiftf): + * cl-macs.el (rotatef): + * cl-macs.el (assert): + * cl-macs.el (cl-defsubst-expand): + * etags.el (buffer-tag-table-list): + * frame.el: + * frame.el (frame-notice-user-settings): + * frame.el (minibuffer-frame-list): + * frame.el (get-frame-for-buffer-noselect): + Use Common Lisp-derived builtins in a few more places, none of + them performance-critical, but the style is better. + +2011-03-08 Aidan Kehoe <kehoea@parhasard.net> + + * buff-menu.el (list-buffers-noselect): + * byte-optimize.el (byte-optimize-identity): + * byte-optimize.el (byte-optimize-if): + * byte-optimize.el (byte-optimize-nth): + * byte-optimize.el (byte-optimize-nthcdr): + * bytecomp.el (byte-compile-warn-wrong-args): + * bytecomp.el (byte-compile-two-args-19->20): + * bytecomp.el (byte-compile-list): + * bytecomp.el (byte-compile-beginning-of-line): + * bytecomp.el (byte-compile-set): + * bytecomp.el (byte-compile-set-default): + * bytecomp.el (byte-compile-values): + * bytecomp.el (byte-compile-values-list): + * bytecomp.el (byte-compile-integerp): + * bytecomp.el (byte-compile-multiple-value-list-internal): + * bytecomp.el (byte-compile-throw): + * cl-macs.el (cl-do-arglist): + * cl-macs.el (cl-parse-loop-clause): + * cl-macs.el (multiple-value-bind): + * cl-macs.el (multiple-value-setq): + * cl-macs.el (get-setf-method): + * cmdloop.el (command-error): + * cmdloop.el (y-or-n-p-minibuf): + * cmdloop.el (yes-or-no-p-minibuf): + * coding.el (unencodable-char-position): + * cus-edit.el (custom-face-prompt): + * cus-edit.el (custom-buffer-create-internal): + * cus-edit.el (widget-face-action): + * cus-edit.el (custom-group-value-create): + * descr-text.el (describe-char-unicode-data): + * dialog-gtk.el (popup-builtin-question-dialog): + * dragdrop.el (experimental-dragdrop-drop-log-function): + * dragdrop.el (experimental-dragdrop-drop-mime-default): + * easymenu.el (easy-menu-add): + * easymenu.el (easy-menu-remove): + * faces.el (read-face-name): + * faces.el (set-face-stipple): + * files.el (file-name-non-special): + * font.el (font-combine-fonts): + * font.el (font-set-face-font): + * font.el (font-parse-rgb-components): + * font.el (font-rgb-color-p): + * font.el (font-color-rgb-components): + * gnuserv.el (gnuserv-edit-files): + * help.el (key-or-menu-binding): + * help.el (function-documentation-1): + * help.el (function-documentation): + * info.el (info): + * isearch-mode.el (isearch-exit): + * isearch-mode.el (isearch-edit-string): + * isearch-mode.el (isearch-*-char): + * isearch-mode.el (isearch-complete1): + * ldap.el (ldap-encode-country-string): + * ldap.el (ldap-decode-string): + * minibuf.el (read-file-name-internal-1): + * minibuf.el (read-non-nil-coding-system): + * minibuf.el (get-user-response): + * mouse.el (drag-window-divider): + * mule/ccl.el: + * mule/ccl.el (ccl-compile-if): + * mule/ccl.el (ccl-compile-break): + * mule/ccl.el (ccl-compile-repeat): + * mule/ccl.el (ccl-compile-write-repeat): + * mule/ccl.el (ccl-compile-call): + * mule/ccl.el (ccl-compile-end): + * mule/ccl.el (ccl-compile-read-multibyte-character): + * mule/ccl.el (ccl-compile-write-multibyte-character): + * mule/ccl.el (ccl-compile-translate-character): + * mule/ccl.el (ccl-compile-mule-to-unicode): + * mule/ccl.el (ccl-compile-unicode-to-mule): + * mule/ccl.el (ccl-compile-lookup-integer): + * mule/ccl.el (ccl-compile-lookup-character): + * mule/ccl.el (ccl-compile-map-multiple): + * mule/ccl.el (ccl-compile-map-single): + * mule/devan-util.el (devanagari-compose-to-one-glyph): + * mule/devan-util.el (devanagari-composition-component): + * mule/mule-cmds.el (finish-set-language-environment): + * mule/viet-util.el: + * mule/viet-util.el (viet-encode-viscii-char): + * multicast.el (open-multicast-group): + * newcomment.el (comment-quote-nested): + * newcomment.el (comment-region): + * newcomment.el (comment-dwim): + * regexp-opt.el (regexp-opt-group): + * replace.el (map-query-replace-regexp): + * specifier.el (derive-device-type-from-tag-set): + * subr.el (skip-chars-quote): + * test-harness.el (test-harness-from-buffer): + * test-harness.el (batch-test-emacs): + * wid-edit.el (widget-choice-action): + * wid-edit.el (widget-symbol-prompt-internal): + * wid-edit.el (widget-color-action): + * window-xemacs.el (push-window-configuration): + * window-xemacs.el (pop-window-configuration): + * window.el (quit-window): + * x-compose.el (electric-diacritic): + It's better style, and cheaper (often one assembler instruction + vs. a C funcall in the byte code), to use `eql' instead of `=' + when it's clear what numerical type a given result will be. Change + much of our code to do this, with the help of a byte-compiler + change (not comitted) that looked for calls to #'length (which + always returns an integer) in its args. + +2011-03-08 Aidan Kehoe <kehoea@parhasard.net> + + * format.el (format-delq-cons): Removed. + * format.el (format-make-relatively-unique): Removed. + * format.el (format-common-tail): Removed. + * format.el (format-reorder): Removed. + * format.el (format-annotate-region): + * format.el (format-annotate-single-property-change): + * format.el (format-annotate-atomic-property-change): + Remove various functions from this file that re-implemented Common + Lisp functions that we have built-in. + +2011-03-08 Aidan Kehoe <kehoea@parhasard.net> + + * select.el (selection-preferred-types): + * select.el (cut-copy-clear-internal): + * select.el (create-image-functions): + * select.el (select-convert-from-image/gif): + * select.el (select-convert-from-image/jpeg): + * select.el (select-convert-from-image/png): + * select.el (select-convert-from-image/tiff): + * select.el (select-convert-from-image/xpm): + * select.el (select-convert-from-image/xbm): + * select.el (selection-converter-in-alist): + Make my Lisp a little more sophisticated in this file. + +2011-03-08 Aidan Kehoe <kehoea@parhasard.net> + + * package-ui.el (pui-add-required-packages): + * packages.el (packages-handle-package-dumped-lisps): + * bytecomp-runtime.el (byte-compile-with-fboundp): + * bytecomp-runtime.el (globally-declare-fboundp): + * bytecomp-runtime.el + (byte-compile-with-byte-compiler-warnings-suppressed): + * mule/devan-util.el (devanagari-reorder-glyphs-for-composition): + * mule/devan-util.el (devanagari-compose-to-one-glyph): + * mule/japanese.el: + * mule/japanese.el ("Japanese"): + * mule/make-coding-system.el (fixed-width-generate-helper): + * mule/mule-category.el (defined-category-list): + * mule/mule-category.el (undefined-category-designator): + Style change: remove redundant lambdas, things like (mapcar + #'(lambda (pkg) (symbol-name pkg)) ...) => (mapcar #'symbol-name ...). + 2011-02-16 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el (byte-compile-normal-call):
--- a/lisp/buff-menu.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/buff-menu.el Thu Mar 17 23:42:59 2011 +0100 @@ -641,8 +641,8 @@ (if (memq files-only '(t nil)) #'(lambda (b) (let ((n (buffer-name b))) - (cond ((and (/= 0 (length n)) - (= (aref n 0) ?\ )) + (cond ((and (not (eql 0 (length n))) + (eql (aref n 0) ?\ )) ;;don't mention if starts with " " nil) (files-only
--- a/lisp/byte-optimize.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/byte-optimize.el Thu Mar 17 23:42:59 2011 +0100 @@ -821,7 +821,7 @@ (nth 1 form) (byte-compile-warn "identity called with %d arg%s, but requires 1" (length (cdr form)) - (if (= 1 (length (cdr form))) "" "s")) + (if (eql 1 (length (cdr form))) "" "s")) form)) (defun byte-optimize-car (form) @@ -1019,7 +1019,7 @@ ;; Don't make a double negative; ;; instead, take away the one that is there. (if (and (consp clause) (memq (car clause) '(not null)) - (= (length clause) 2)) ; (not xxxx) or (not (xxxx)) + (eql (length clause) 2)) ; (not xxxx) or (not (xxxx)) (nth 1 clause) (list 'not clause)) (if (nthcdr 4 form) @@ -1161,7 +1161,7 @@ (put 'nth 'byte-optimizer 'byte-optimize-nth) (defun byte-optimize-nth (form) - (if (and (= (safe-length form) 3) (memq (nth 1 form) '(0 1))) + (if (and (eql (safe-length form) 3) (memq (nth 1 form) '(0 1))) (list 'car (if (zerop (nth 1 form)) (nth 2 form) (list 'cdr (nth 2 form)))) @@ -1169,7 +1169,7 @@ (put 'nthcdr 'byte-optimizer 'byte-optimize-nthcdr) (defun byte-optimize-nthcdr (form) - (if (and (= (safe-length form) 3) (not (memq (nth 1 form) '(0 1 2)))) + (if (and (eql (safe-length form) 3) (not (memq (nth 1 form) '(0 1 2)))) (byte-optimize-predicate form) (let ((count (nth 1 form))) (setq form (nth 2 form))
--- a/lisp/bytecomp-runtime.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/bytecomp-runtime.el Thu Mar 17 23:42:59 2011 +0100 @@ -308,7 +308,7 @@ (let ((symbols (eval (car (cdr form))))) (unless (consp symbols) (setq symbols (list symbols))) - (setq symbols (mapcar #'(lambda (sym) (cons sym nil)) symbols)) + (setq symbols (mapcar #'list symbols)) (setq byte-compile-unresolved-functions (set-difference byte-compile-unresolved-functions symbols :key #'car)) @@ -425,7 +425,7 @@ ;; have an autoload later in the file for any functions in FUNCTIONS. ;; This is not something that code should ever do, though.) (setq byte-compile-autoload-environment - (append (mapcar #'(lambda (sym) (cons sym nil)) functions) + (append (mapcar #'list functions) byte-compile-autoload-environment))) nil)
--- a/lisp/bytecomp.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/bytecomp.el Thu Mar 17 23:42:59 2011 +0100 @@ -3159,8 +3159,8 @@ (byte-defop-compiler skip-chars-forward 1-2+1) (byte-defop-compiler skip-chars-backward 1-2+1) (byte-defop-compiler eq 2) -(byte-defop-compiler20 old-eq 2) -(byte-defop-compiler20 old-memq 2) +; (byte-defop-compiler20 old-eq 2) +; (byte-defop-compiler20 old-memq 2) (byte-defop-compiler cons 2) (byte-defop-compiler aref 2) (byte-defop-compiler get 2+1) @@ -3177,7 +3177,7 @@ (byte-defop-compiler string< 2) (byte-defop-compiler (string-equal byte-string=) 2) (byte-defop-compiler (string-lessp byte-string<) 2) -(byte-defop-compiler20 old-equal 2) +; (byte-defop-compiler20 old-equal 2) (byte-defop-compiler nthcdr 2) (byte-defop-compiler elt 2) (byte-defop-compiler20 old-member 2) @@ -3218,7 +3218,7 @@ (when (memq 'subr-callargs byte-compile-warnings) (byte-compile-warn "%s called with %d arg%s, but requires %s" (car form) (length (cdr form)) - (if (= 1 (length (cdr form))) "" "s") n))) + (if (eql 1 (length (cdr form))) "" "s") n))) (defun byte-compile-subr-wrong-args (form n) (byte-compile-warn-wrong-args form n) @@ -3343,7 +3343,7 @@ ;; XEmacs: used for functions that have a different opcode in v19 than v20. ;; this includes `eq', `equal', and other old-ified functions. (defun byte-compile-two-args-19->20 (form) - (if (not (= (length form) 3)) + (if (not (eql (length form) 3)) (byte-compile-subr-wrong-args form 2) (byte-compile-form (car (cdr form))) ;; Push the arguments (byte-compile-form (nth 2 form)) @@ -3444,7 +3444,7 @@ (let* ((args (cdr form)) (nargs (length args))) (cond - ((= nargs 0) + ((eql nargs 0) (byte-compile-constant nil)) ((< nargs 5) (mapc 'byte-compile-form args) @@ -3694,7 +3694,7 @@ (let ((len (length form))) (cond ((> len 3) (byte-compile-subr-wrong-args form "0-2")) - ((or (= len 3) (not (byte-compile-constp (nth 1 form)))) + ((or (eql len 3) (not (byte-compile-constp (nth 1 form)))) (byte-compile-normal-call form)) (t (byte-compile-form @@ -3764,8 +3764,7 @@ (let* ((args (cdr form)) (nargs (length args)) (var (car args))) - (when (and (= (safe-length var) 2) - (eq (car var) 'quote)) + (when (and (eql (safe-length var) 2) (eq (car var) 'quote)) (let ((sym (nth 1 var))) (cond ((not (symbolp sym)) @@ -3784,7 +3783,7 @@ (t (byte-compile-warn "assignment to free variable %s" sym) (push sym byte-compile-free-assignments))))) - (if (= nargs 2) + (if (eql nargs 2) ;; now emit a normal call to set-default (byte-compile-normal-call form) (byte-compile-subr-wrong-args form 2)))) @@ -3921,7 +3920,7 @@ (byte-compile-body form t)) (defun byte-compile-values (form) - (if (= 2 (length form)) + (if (eql 2 (length form)) (if (byte-compile-constp (second form)) (byte-compile-form-do-effect (second form)) ;; #'or compiles to bytecode, #'values doesn't: @@ -3929,7 +3928,7 @@ (byte-compile-normal-call form))) (defun byte-compile-values-list (form) - (if (and (= 2 (length form)) + (if (and (eql 2 (length form)) (or (null (second form)) (and (consp (second form)) (eq (car (second form)) @@ -4108,7 +4107,7 @@ ;; anyway). (defun byte-compile-integerp (form) - (if (/= 2 (length form)) + (if (not (eql (length form) 2)) (byte-compile-subr-wrong-args form 1) (let ((donetag (byte-compile-make-tag)) (wintag (byte-compile-make-tag)) @@ -4336,7 +4335,7 @@ :test #'equal))) (defun byte-compile-multiple-value-list-internal (form) - (if (/= 4 (length form)) + (if (not (eql 4 (length form))) (progn (byte-compile-warn-wrong-args form 3) (byte-compile-normal-call @@ -4358,7 +4357,7 @@ ;; form, it provokes an invalid-function error instead (or at least it ;; should; there's a kludge around for the moment in eval.c that avoids ;; that, but this file should not assume that that will always be there). - (if (/= 2 (length (cdr form))) + (if (not (eql 2 (length (cdr form)))) (progn (byte-compile-warn-wrong-args form 2) (byte-compile-normal-call
--- a/lisp/cl-macs.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/cl-macs.el Thu Mar 17 23:42:59 2011 +0100 @@ -426,7 +426,7 @@ (or (eq p args) (setq minarg (list 'cdr minarg))) (setq p (cdr p))) (if (memq (car p) '(nil &aux)) - (setq minarg (list '= (list 'length restarg) + (setq minarg (list 'eql (list 'length restarg) (length (ldiff args p))) exactarg (not (eq args p))))) (while (and args (not (memq (car args) lambda-list-keywords))) @@ -1064,7 +1064,7 @@ Specify the name for block surrounding the loop, in place of nil. (See `block'.) " - (if (not (memq t (mapcar 'symbolp (delq nil (delq t (copy-list clauses)))))) + (if (notany #'symbolp (set-difference clauses '(nil t))) (list 'block nil (list* 'while t clauses)) (let ((loop-name nil) (loop-bindings nil) (loop-body nil) (loop-steps nil) @@ -1263,7 +1263,7 @@ (seq (cl-pop2 args)) (temp-seq (gensym)) (temp-idx (if (eq (car args) 'using) - (if (and (= (length (cadr args)) 2) + (if (and (eql (length (cadr args)) 2) (eq (caadr args) 'index)) (cadr (cl-pop2 args)) (error "Bad `using' clause")) @@ -1294,7 +1294,7 @@ (or (memq (car args) '(in of)) (error "Expected `of'")) (let* ((table (cl-pop2 args)) (other (if (eq (car args) 'using) - (if (and (= (length (cadr args)) 2) + (if (and (eql (length (cadr args)) 2) (memq (caadr args) hash-types) (not (eq (caadr args) word))) (cadr (cl-pop2 args)) @@ -1350,7 +1350,7 @@ (let* ((map (cl-pop2 args)) other-word (other (if (eq (car args) 'using) - (if (and (= (length (cadr args)) 2) + (if (and (eql (length (cadr args)) 2) (memq (setq other-word (caadr args)) key-types) (not (eq (caadr args) word))) @@ -1646,12 +1646,12 @@ steps) (list* 'while (list 'not (car endtest)) (append body - (let ((sets (mapcar + (let ((sets (mapcan #'(lambda (c) (and (consp c) (cdr (cdr c)) - (list (car c) (nth 2 c)))) + (list + (list (car c) (nth 2 c))))) steps))) - (setq sets (delq nil sets)) (and sets (list (cons (if (or star (not (cdr sets))) 'setq 'psetq) @@ -1878,7 +1878,7 @@ Returns the value given by the last element of BODY." (if (null syms) `(progn ,form ,@body) - (if (= 1 (length syms)) + (if (eql 1 (length syms)) ;; Code written to deal with other "implementations" of multiple ;; values may have a one-element SYMS. `(let ((,(car syms) ,form)) @@ -1905,7 +1905,7 @@ (if (null syms) ;; Never return multiple values from multiple-value-setq: (and form `(values ,form)) - (if (= 1 (length syms)) + (if (eql 1 (length syms)) `(setq ,(car syms) ,form) (let ((temp (gensym))) `(let* ((,temp (multiple-value-list-internal 0 ,(length syms) ,form))) @@ -2432,7 +2432,7 @@ (or (and method (let ((cl-macro-environment env)) (setq method (apply method (cdr place)))) - (if (and (consp method) (= (length method) 5)) + (if (and (consp method) (eql (length method) 5)) method (error "Setf-method for %s returns malformed method" func))) @@ -2577,7 +2577,7 @@ Example: (shiftf A B C) sets A to B, B to C, and returns the old A. Each PLACE may be a symbol, or any generalized variable allowed by `setf'." ;; XEmacs change: use iteration instead of recursion - (if (not (memq nil (mapcar 'symbolp (butlast (cons place args))))) + (if (every #'symbolp (butlast (cons place args))) (list* 'prog1 place (let ((sets nil)) (while args @@ -2598,7 +2598,7 @@ "Rotate left among PLACES. Example: (rotatef A B C) sets A to B, B to C, and C to A. It returns nil. Each PLACE may be a symbol, or any generalized variable allowed by `setf'." - (if (not (memq nil (mapcar 'symbolp places))) + (if (every #'symbolp places) (and (cdr places) (let ((sets nil) (first (car places))) @@ -3125,11 +3125,7 @@ omitted, a default message listing FORM itself is used." (and (or (not (cl-compiling-file)) (< cl-optimize-speed 3) (= cl-optimize-safety 3)) - (let ((sargs (and show-args (delq nil (mapcar - #'(lambda (x) - (and (not (cl-const-expr-p x)) - x)) - (cdr form)))))) + (let ((sargs (and show-args (remove-if #'cl-const-expr-p (cdr form))))) (list 'progn (list 'or form (if string @@ -3224,13 +3220,12 @@ (defun cl-defsubst-expand (argns body simple whole unsafe &rest argvs) (if (and whole (not (cl-safe-expr-p (cons 'progn argvs)))) whole (if (cl-simple-exprs-p argvs) (setq simple t)) - (let ((lets (delq nil - (mapcar* #'(lambda (argn argv) - (if (or simple (cl-const-expr-p argv)) - (progn (setq body (subst argv argn body)) - (and unsafe (list argn argv))) - (list argn argv))) - argns argvs)))) + (let ((lets (mapcan #'(lambda (argn argv) + (if (or simple (cl-const-expr-p argv)) + (progn (setq body (subst argv argn body)) + (and unsafe (list (list argn argv)))) + (list (list argn argv)))) + argns argvs))) (if lets (list 'let lets body) body))))
--- a/lisp/cmdloop.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/cmdloop.el Thu Mar 17 23:42:59 2011 +0100 @@ -146,7 +146,7 @@ (message nil) (ding nil (cond ((eq etype 'undefined-keystroke-sequence) (if (and (vectorp (nth 1 error-object)) - (/= 0 (length (nth 1 error-object))) + (not (eql 0 (length (nth 1 error-object)))) (button-event-p (aref (nth 1 error-object) 0))) 'undefined-click 'undefined-key)) @@ -468,7 +468,7 @@ (single-key-description event)) (ding nil 'y-or-n-p) (discard-input) - (if (= (length pre) 0) + (if (eql (length pre) 0) (setq pre (gettext "Please answer y or n. "))))))) yn))) @@ -505,7 +505,7 @@ ;; and-fboundp is redundant, since yes-or-no-p-dialog-box is only ;; bound if (featurep 'dialog). But it eliminates a compile-time ;; warning. - (and-fboundp #'yes-or-no-p-dialog-box (yes-or-no-p-dialog-box prompt)) + (and-fboundp 'yes-or-no-p-dialog-box (yes-or-no-p-dialog-box prompt)) (yes-or-no-p-minibuf prompt))) (defun y-or-n-p (prompt)
--- a/lisp/coding.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/coding.el Thu Mar 17 23:42:59 2011 +0100 @@ -376,7 +376,7 @@ (< (length result) count)) (push (if stringp (1- begin) begin) result) (incf begin)) - (when (= (length result) count) + (when (eql (length result) count) (return-from worked-it-all-out result))) ranges) (map-range-table
--- a/lisp/cus-edit.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/cus-edit.el Thu Mar 17 23:42:59 2011 +0100 @@ -868,7 +868,7 @@ ;; under point: (let ((choice (completing-read "Customize face: (default all) " obarray 'find-face))) - (if (zerop (length choice)) + (if (eql (length choice) 0) nil (list (intern choice)))) (cond ((symbolp faces) @@ -882,7 +882,7 @@ (list (symbol-name face) face)) faces) nil t))) - (if (zerop (length choice)) + (if (eql (length choice) 0) (list faces) (list (intern choice))))))))) @@ -1182,7 +1182,7 @@ (widget-insert "\n") (message "Creating customization items...") (setq custom-options - (if (= (length options) 1) + (if (eql (length options) 1) (mapcar (lambda (entry) (widget-create (nth 1 entry) :documentation-shown t @@ -2983,7 +2983,7 @@ (face-list)) nil nil nil 'face-history))) - (unless (zerop (length answer)) + (unless (eql (length answer) 0) (widget-value-set widget (intern answer)) (widget-apply widget :notify widget event) (widget-setup)))) @@ -3172,7 +3172,7 @@ (insert " " tag "\n") (widget-put widget :buttons buttons)) ((and (eq custom-buffer-style 'tree) - (zerop (length members))) + (eql (length members) 0)) (custom-browse-insert-prefix prefix) (insert "[ ]-- ") ;; (widget-glyph-insert nil "[ ]" "empty") @@ -3185,7 +3185,7 @@ ((eq custom-buffer-style 'tree) (custom-browse-insert-prefix prefix) (custom-load-widget widget) - (if (zerop (length members)) + (if (eql (length members) 0) (progn (custom-browse-insert-prefix prefix) (insert "[ ]-- ")
--- a/lisp/custom.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/custom.el Thu Mar 17 23:42:59 2011 +0100 @@ -323,6 +323,9 @@ `class' (the frame's color support) Should be one of `color', `grayscale', or `mono'. +`min-colors' (the minimum number of colors the frame supports) + Should be in integer which is compared to `display-color-cells' + `background' (what color is used for the background text) Should be one of `light' or `dark'.
--- a/lisp/descr-text.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/descr-text.el Thu Mar 17 23:42:59 2011 +0100 @@ -765,8 +765,8 @@ (line-end-position)) ";") :test 'equal)))) ;; The length depends on whether the last field was empty. - (unless (or (= 13 (length fields)) - (= 14 (length fields))) + (unless (or (eql 13 (length fields)) + (eql 14 (length fields))) (error 'invalid-argument (format "Invalid contents in %s" describe-char-unicodedata-file))) @@ -1118,7 +1118,7 @@ ; (push (format "%s;" (pop props)) ps)) ; (list (cons "Properties" (nreverse ps))))) ("to input" - ,@(let ((key-list (and-fboundp #'quail-find-key + ,@(let ((key-list (and-fboundp 'quail-find-key current-input-method (quail-find-key char)))) (if (consp key-list)
--- a/lisp/diagnose.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/diagnose.el Thu Mar 17 23:42:59 2011 +0100 @@ -145,7 +145,7 @@ (window-list fr t)) (frame-list)) 16)) - (when-fboundp #'sort-numeric-fields + (when-fboundp 'sort-numeric-fields (sort-numeric-fields -1 (save-excursion (goto-char begin) @@ -179,7 +179,7 @@ (princ "\n") (princ (format fmt "total" total)) (incf grandtotal total)) - (when-fboundp #'sort-numeric-fields + (when-fboundp 'sort-numeric-fields (sort-numeric-fields -1 (save-excursion (goto-char begin) @@ -287,7 +287,7 @@ total-non-lisp-use "")) (incf grandtotal total-use-with-overhead) (incf grandtotal total-non-lisp-use) - (when-fboundp #'sort-numeric-fields + (when-fboundp 'sort-numeric-fields (sort-numeric-fields -4 (save-excursion (goto-char begin) @@ -310,7 +310,7 @@ "Show statistics about memory usage of the new allocator." (interactive) (garbage-collect) - (if-fboundp #'mc-alloc-memory-usage + (if-fboundp 'mc-alloc-memory-usage (let* ((stats (mc-alloc-memory-usage)) (page-size (first stats)) (heap-sects (second stats)) @@ -463,7 +463,7 @@ (defun show-gc-stats () "Show statistics about garbage collection cycles." (interactive) - (if-fboundp #'gc-stats + (if-fboundp 'gc-stats (let ((buffer "*garbage collection statistics*") (plist (gc-stats)) (fmt "%-9s %16s %12s %12s %12s %12s\n"))
--- a/lisp/dialog-gtk.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/dialog-gtk.el Thu Mar 17 23:42:59 2011 +0100 @@ -254,13 +254,13 @@ (setq length (length button)) (cond - ((= length 1) ; [ "name" ] + ((eql length 1) ; [ "name" ] (setq callback nil activep nil)) - ((= length 2) ; [ "name" callback ] + ((eql length 2) ; [ "name" callback ] (setq callback (aref button 1) activep t)) - ((and (or (= length 3) (= length 4)) + ((and (or (eql length 3) (eql length 4)) (not (keywordp (aref button 2)))) ;; [ "name" callback active-p ] or ;; [ "name" callback active-p suffix ]
--- a/lisp/dragdrop.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/dragdrop.el Thu Mar 17 23:42:59 2011 +0100 @@ -212,7 +212,7 @@ ((eq (car object) 'dragdrop-MIME) "MIME") (t "UNKNOWN")) (length (cdr object)) - (if (= (length (cdr object)) 1) "element" "elements"))) + (if (eql (length (cdr object)) 1) "element" "elements"))) (let ((i 1) (data (cdr object))) (while (not (eq data ())) @@ -278,7 +278,7 @@ (while (not (eq ldata ())) (setq data (car ldata)) (if (and (listp data) - (= (length data) 3) + (eql (length data) 3) (listp (car data)) (stringp (caar data)) (string= (caar data) "text/plain") @@ -306,7 +306,7 @@ (and (featurep 'tm-view) (declare-fboundp (mime/viewer-mode buf)))) ((and (listp data) - (= (length data) 3)) + (eql (length data) 3)) ;; change the internal content-type representation to the ;; way tm does it ("content/type" (key . value)*) ;; but for now list will do the job
--- a/lisp/easymenu.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/easymenu.el Thu Mar 17 23:42:59 2011 +0100 @@ -192,7 +192,7 @@ ; (default-value 'mode-popup-menu) easy-menu-all-popups) (when (featurep 'menubar) ;; Save the existing mode-popup-menu, if it's been changed. - (when (and (zerop (length easy-menu-all-popups)) + (when (and (eql (length easy-menu-all-popups) 0) (not (equal (default-value 'mode-popup-menu) mode-popup-menu))) (push mode-popup-menu easy-menu-all-popups)) ;; Add the menu to our list of all the popups for the buffer. @@ -200,7 +200,7 @@ ;; If there are multiple popup menus available, make the popup menu ;; normally shown with button-3 a menu of them. If there is just one, ;; make that button show it, and no super-menu. - (setq mode-popup-menu (if (= 1 (length easy-menu-all-popups)) + (setq mode-popup-menu (if (eql 1 (length easy-menu-all-popups)) (car easy-menu-all-popups) (cons (easy-menu-title) (reverse easy-menu-all-popups)))) @@ -227,13 +227,13 @@ ;; If there are multiple popup menus available, make the popup menu ;; normally shown with button-3 a menu of them. If there is just one, ;; make that button show it, and no super-menu. - mode-popup-menu (if (= 1 (length easy-menu-all-popups)) + mode-popup-menu (if (eql 1 (length easy-menu-all-popups)) (car easy-menu-all-popups) (cons (easy-menu-title) (reverse easy-menu-all-popups)))) ;; If we've just set mode-popup-menu to an empty menu, change that menu ;; to its default value (without intervention from easy-menu). - (if (zerop (length easy-menu-all-popups)) + (if (eql (length easy-menu-all-popups) 0) (setq mode-popup-menu (default-value 'mode-popup-menu))) (and current-menubar (assoc (car menu) current-menubar)
--- a/lisp/etags.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/etags.el Thu Mar 17 23:42:59 2011 +0100 @@ -241,16 +241,15 @@ (push expression result) (error "Expression in tag-table-alist evaluated to non-string"))))) (setq result - (mapcar + (mapcan (lambda (name) (when (file-directory-p name) (setq name (concat (file-name-as-directory name) "TAGS"))) (and (file-readable-p name) ;; get-tag-table-buffer has side-effects - (symbol-value-in-buffer 'buffer-file-name - (get-tag-table-buffer name)))) + (list (symbol-value-in-buffer 'buffer-file-name + (get-tag-table-buffer name))))) result)) - (setq result (delq nil result)) ;; If no TAGS file has been found, ask the user explicitly. ;; #### tags-file-name is *evil*. (or result tags-file-name
--- a/lisp/faces.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/faces.el Thu Mar 17 23:42:59 2011 +0100 @@ -57,7 +57,7 @@ (defun read-face-name (prompt) (let (face) - (while (= (length face) 0) ; nil or "" + (while (eql (length face) 0) ; nil or "" (setq face (completing-read prompt (mapcar (lambda (x) (list (symbol-name x))) (face-list)) @@ -476,7 +476,7 @@ (let (matchspec) ;; get-charset signals an error if its argument doesn't have an ;; associated charset. - (setq charset (if-fboundp #'get-charset + (setq charset (if-fboundp 'get-charset (get-charset charset) (error 'unimplemented "Charset support not available")) matchspec (cons charset nil)) @@ -1700,6 +1700,7 @@ (type (plist-get props 'type)) (class (plist-get props 'class)) (background (plist-get props 'background)) + (min-colors (plist-get props 'min-colors)) (match t) (entries display) entry req options) @@ -1712,6 +1713,8 @@ (type (memq type options)) (class (memq class options)) (background (memq background options)) + (min-colors (>= (display-color-cells frame) + (car options))) (t (warn "Unknown req `%S' with options `%S'" req options) nil)))) @@ -2037,14 +2040,14 @@ '(".xbm" ""))))) (and file `[xbm :file ,file]))) - ((and (listp pixmap) (= (length pixmap) 3)) + ((and (listp pixmap) (eql (length pixmap) 3)) `[xbm :data ,pixmap]) (t nil)))) ;; We're signaling a continuable error; let's make sure the ;; function `stipple-pixmap-p' at least exists. (flet ((stipple-pixmap-p (pixmap) (or (stringp pixmap) - (and (listp pixmap) (= (length pixmap) 3))))) + (and (listp pixmap) (eql (length pixmap) 3))))) (setq pixmap (signal 'wrong-type-argument (list 'stipple-pixmap-p pixmap))))) (check-type frame (or null frame))
--- a/lisp/files.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/files.el Thu Mar 17 23:42:59 2011 +0100 @@ -996,9 +996,9 @@ (read-coding-system "Coding system: ")) t)) (let ((value (find-file filename codesys wildcards))) - (mapcar #'(lambda (buffer) - (set-symbol-value-in-buffer 'buffer-read-only t buffer)) - (if (listp value) value (list value))) + (mapc #'(lambda (buffer) + (set-symbol-value-in-buffer 'buffer-read-only t buffer)) + (if (listp value) value (list value))) value)) (defun find-file-read-only-other-window (filename &optional codesys wildcards) @@ -4553,7 +4553,7 @@ (and (car pair) (string-match "\\`/:" (car pair)) (setcar pair - (if (= (length (car pair)) 2) + (if (eql (length (car pair)) 2) "/" (substring (car pair) 2))))) (setq file-arg-indices (cdr file-arg-indices))))
--- a/lisp/font.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/font.el Thu Mar 17 23:42:59 2011 +0100 @@ -426,7 +426,7 @@ (cond ((null args) (error "Wrong number of arguments to font-combine-fonts")) - ((= (length args) 1) + ((eql (length args) 1) (car args)) (t (let ((retval (font-combine-fonts-internal (nth 0 args) (nth 1 args)))) @@ -988,7 +988,7 @@ ;;; ###autoload (defun font-set-face-font (&optional face font &rest args) (cond - ((and (vectorp font) (= (length font) 12)) + ((and (vectorp font) (eql (length font) 12)) (let ((font-name (font-create-name font))) (set-face-property face 'font-specification font) (cond @@ -1175,28 +1175,28 @@ r g b str) (cond ((string-match "^#[0-9a-f]+$" color) (cond - ((= (length color) 4) + ((eql (length color) 4) (setq r (font-hex-string-to-number (substring color 1 2)) g (font-hex-string-to-number (substring color 2 3)) b (font-hex-string-to-number (substring color 3 4)) r (* r 4096) g (* g 4096) b (* b 4096))) - ((= (length color) 7) + ((eql (length color) 7) (setq r (font-hex-string-to-number (substring color 1 3)) g (font-hex-string-to-number (substring color 3 5)) b (font-hex-string-to-number (substring color 5 7)) r (* r 256) g (* g 256) b (* b 256))) - ((= (length color) 10) + ((eql (length color) 10) (setq r (font-hex-string-to-number (substring color 1 4)) g (font-hex-string-to-number (substring color 4 7)) b (font-hex-string-to-number (substring color 7 10)) r (* r 16) g (* g 16) b (* b 16))) - ((= (length color) 13) + ((eql (length color) 13) (setq r (font-hex-string-to-number (substring color 1 5)) g (font-hex-string-to-number (substring color 5 9)) b (font-hex-string-to-number (substring color 9 13)))) @@ -1231,7 +1231,7 @@ (defun font-rgb-color-p (obj) (or (and (vectorp obj) - (= (length obj) 4) + (eql (length obj) 4) (eq (aref obj 0) 'rgb)))) (defun font-rgb-color-red (obj) (aref obj 1)) @@ -1255,11 +1255,11 @@ (list (font-rgb-color-red color) (font-rgb-color-green color) (font-rgb-color-blue color))) - ((and (vectorp color) (= 3 (length color))) + ((and (vectorp color) (eql 3 (length color))) (list (aref color 0) (aref color 1) (aref color 2))) - ((and (listp color) (= 3 (length color)) (floatp (car color))) + ((and (listp color) (eql 3 (length color)) (floatp (car color))) (mapcar #'(lambda (x) (* x 65535)) color)) - ((and (listp color) (= 3 (length color))) + ((and (listp color) (eql 3 (length color))) color) ((or (string-match "^#" color) (string-match "^rgb:" color))
--- a/lisp/format.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/format.el Thu Mar 17 23:42:59 2011 +0100 @@ -435,68 +435,6 @@ (match-beginning 0))))) (setq alist (cdr alist))))))) -;;; Some list-manipulation functions that we need. - -(defun format-delq-cons (cons list) - "Remove the given CONS from LIST by side effect, -and return the new LIST. Since CONS could be the first element -of LIST, write `\(setq foo \(format-delq-cons element foo))' to be sure of -changing the value of `foo'." - (if (eq cons list) - (cdr list) - (let ((p list)) - (while (not (eq (cdr p) cons)) - (if (null p) (error "format-delq-cons: not an element.")) - (setq p (cdr p))) - ;; Now (cdr p) is the cons to delete - (setcdr p (cdr cons)) - list))) - -;; XEmacs: this is #'nset-exclusive-or with a :test of #'equal, though we -;; probably don't want to replace it right now. -(defun format-make-relatively-unique (a b) - "Delete common elements of lists A and B, return as pair. -Compares using `equal'." - (let* ((acopy (copy-sequence a)) - (bcopy (copy-sequence b)) - (tail acopy)) - (while tail - (let ((dup (member (car tail) bcopy)) - (next (cdr tail))) - (if dup (setq acopy (format-delq-cons tail acopy) - bcopy (format-delq-cons dup bcopy))) - (setq tail next))) - (cons acopy bcopy))) - -(defun format-common-tail (a b) - "Given two lists that have a common tail, return it. -Compares with `equal', and returns the part of A that is equal to the -equivalent part of B. If even the last items of the two are not equal, -returns nil." - (let ((la (length a)) - (lb (length b))) - ;; Make sure they are the same length - (if (> la lb) - (setq a (nthcdr (- la lb) a)) - (setq b (nthcdr (- lb la) b)))) - (while (not (equal a b)) - (setq a (cdr a) - b (cdr b))) - a) - -(defun format-reorder (items order) - "Arrange ITEMS to following partial ORDER. -Elements of ITEMS equal to elements of ORDER will be rearranged to follow the -ORDER. Unmatched items will go last." - (if order - (let ((item (member (car order) items))) - (if item - (cons (car item) - (format-reorder (format-delq-cons item items) - (cdr order))) - (format-reorder items (cdr order)))) - items)) - (put 'face 'format-list-valued t) ; These text-properties take values (put 'unknown 'format-list-valued t) ; that are lists, the elements of which ; should be considered separately. @@ -818,7 +756,11 @@ (< loc to))) (or loc (setq loc from)) (let* ((ans (format-annotate-location loc (= loc from) ignore trans)) - (neg-ans (format-reorder (aref ans 0) open-ans)) + (neg-ans (sort* (aref ans 0) '< + :key #'(lambda (object) + (or + (position object open-ans :test 'equal) + most-positive-fixnum)))) (pos-ans (aref ans 1)) (ignored (aref ans 2))) (setq not-found (append ignored not-found) @@ -927,7 +869,6 @@ (if (or (consp old) (consp new)) (let* ((old (if (listp old) old (list old))) (new (if (listp new) new (list new))) - ;; (tail (format-common-tail old new)) close open) (while old (setq close @@ -941,7 +882,9 @@ prop-alist nil (car new))) open) new (cdr new))) - (format-make-relatively-unique close open)) + (cons + (set-difference close open :stable t) + (set-difference open close :stable t))) (format-annotate-atomic-property-change prop-alist old new))))) (defun format-annotate-atomic-property-change (prop-alist old new) @@ -978,7 +921,9 @@ (let ((close (and old (cdr (assoc old prop-alist)))) (open (and new (cdr (assoc new prop-alist))))) (if (or close open) - (format-make-relatively-unique close open) + (cons + (set-difference close open :stable t) + (set-difference open close :stable t)) ;; Call "Default" function, if any (let ((default (assq nil prop-alist))) (if default
--- a/lisp/frame.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/frame.el Thu Mar 17 23:42:59 2011 +0100 @@ -473,12 +473,13 @@ ;; onto a new frame. The default-minibuffer-frame ;; variable must be handled similarly. (let ((users-of-initial - (filtered-frame-list + (remove-if-not #'(lambda (frame) (and (not (eq frame frame-initial-frame)) (eq (window-frame (minibuffer-window frame)) - frame-initial-frame)))))) + frame-initial-frame))) + (frame-list)))) (if (or users-of-initial (eq default-minibuffer-frame frame-initial-frame)) @@ -486,10 +487,11 @@ ;; are only minibuffers. (let* ((new-surrogate (car - (or (filtered-frame-list + (or (remove-if-not #'(lambda (frame) (eq 'only - (frame-property frame 'minibuffer)))) + (frame-property frame 'minibuffer))) + (frame-list)) (minibuffer-frame-list)))) (new-minibuffer (minibuffer-window new-surrogate))) @@ -672,29 +674,22 @@ ;; XEmacs change: Emacs has make-frame here. We have it in C, so no need for ;; frame-creation-function. -;; XEmacs addition: support optional DEVICE argument. +;; XEmacs addition: support optional DEVICE argument, use delete-if-not. (defun filtered-frame-list (predicate &optional device) "Return a list of all live frames which satisfy PREDICATE. If optional second arg DEVICE is non-nil, restrict the frames returned to that device." - (let ((frames (if device (device-frame-list device) - (frame-list))) - good-frames) - (while (consp frames) - (if (funcall predicate (car frames)) - (setq good-frames (cons (car frames) good-frames))) - (setq frames (cdr frames))) - good-frames)) + (delete-if-not predicate + (if device (device-frame-list device) (frame-list)))) ;; XEmacs addition: support optional DEVICE argument. (defun minibuffer-frame-list (&optional device) "Return a list of all frames with their own minibuffers. If optional second arg DEVICE is non-nil, restrict the frames returned to that device." - (filtered-frame-list - #'(lambda (frame) - (eq frame (window-frame (minibuffer-window frame)))) - device)) + (delete-if-not + #'(lambda (frame) (eq frame (window-frame (minibuffer-window frame)))) + (if device (device-frame-list device) (frame-list)))) ;; XEmacs omission: Emacs has frames-on-display-list here, but that is ;; essentially equivalent to supplying the optional DEVICE argument to @@ -1743,9 +1738,10 @@ (or (plist-get default-frame-plist 'name) default-frame-name)) (frames - (sort (filtered-frame-list #'(lambda (x) - (or (frame-visible-p x) - (frame-iconified-p x)))) + (sort (remove-if-not #'(lambda (x) + (or (frame-visible-p x) + (frame-iconified-p x))) + (frame-list)) #'(lambda (s1 s2) (cond ((and (frame-visible-p s1) (not (frame-visible-p s2))))
--- a/lisp/gnuserv.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/gnuserv.el Thu Mar 17 23:42:59 2011 +0100 @@ -466,7 +466,7 @@ (select-frame frame) (setq gnuserv-current-client nil) ;; If the device was created by this client, push it to the list. - (and (/= old-device-num (length (device-list))) + (and (not (eql old-device-num (length (device-list)))) (push device gnuserv-devices)) (and (frame-iconified-p frame) (deiconify-frame frame))
--- a/lisp/gtk-font-menu.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/gtk-font-menu.el Thu Mar 17 23:42:59 2011 +0100 @@ -90,7 +90,7 @@ ;; #### - this should implement a `menus-only' option, which would ;; recalculate the menus from the cache w/o having to do font-list again. (unless gtk-font-regexp-ascii - (setq gtk-font-regexp-ascii (if-fboundp #'charset-registries + (setq gtk-font-regexp-ascii (if-fboundp 'charset-registries (aref (charset-registries 'ascii) 0) "iso8859-1"))) (setq gtk-font-menu-registry-encoding
--- a/lisp/help.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/help.el Thu Mar 17 23:42:59 2011 +0100 @@ -348,7 +348,7 @@ ;; If the key typed was really a menu selection, grab the form out ;; of the event object and intuit the function that would be called, ;; and describe that instead. - (if (and (vectorp key) (= 1 (length key)) + (if (and (vectorp key) (eql 1 (length key)) (or (misc-user-event-p (aref key 0)) (eq (car-safe (aref key 0)) 'menu-selection))) (let ((event (aref key 0))) @@ -1228,7 +1228,7 @@ (setq args (match-string 1 doc)) (setq doc (substring doc 0 (match-beginning 0))) (and args (setq args (replace-in-string args "[ ]*\\\\\n[ \t]*" " " t))) - (and (zerop (length doc)) (setq doc (gettext "not documented")))) + (and (eql 0 (length doc)) (setq doc (gettext "not documented")))) (cons doc args))) (defun function-documentation (function &optional strip-arglist) @@ -1298,14 +1298,14 @@ (defvar help-symbol-function-context-menu '(["View %_Documentation" (help-symbol-run-function 'describe-function)] ["Find %_Function Source" (help-symbol-run-function 'find-function) - (fboundp #'find-function)] + (fboundp 'find-function)] ["Find %_Tag" (help-symbol-run-function 'find-tag)] )) (defvar help-symbol-variable-context-menu '(["View %_Documentation" (help-symbol-run-function 'describe-variable)] ["Find %_Variable Source" (help-symbol-run-function 'find-variable) - (fboundp #'find-variable)] + (fboundp 'find-variable)] ["Find %_Tag" (help-symbol-run-function 'find-tag)] )) @@ -1315,9 +1315,9 @@ ["View Variable D%_ocumentation" (help-symbol-run-function 'describe-variable)] ["Find %_Function Source" (help-symbol-run-function 'find-function) - (fboundp #'find-function)] + (fboundp 'find-function)] ["Find %_Variable Source" (help-symbol-run-function 'find-variable) - (fboundp #'find-variable)] + (fboundp 'find-variable)] ["Find %_Tag" (help-symbol-run-function 'find-tag)] )) @@ -1856,12 +1856,12 @@ "Follow any cross reference to source code; if none, scroll up. " (interactive "d") (let ((e (extent-at pos nil 'find-function-symbol))) - (if (and-fboundp #'find-function e) - (with-fboundp #'find-function + (if (and-fboundp 'find-function e) + (with-fboundp 'find-function (find-function (extent-property e 'find-function-symbol))) (setq e (extent-at pos nil 'find-variable-symbol)) - (if (and-fboundp #'find-variable e) - (with-fboundp #'find-variable + (if (and-fboundp 'find-variable e) + (with-fboundp 'find-variable (find-variable (extent-property e 'find-variable-symbol))) (scroll-up 1))))) @@ -1871,12 +1871,12 @@ (interactive "e") (mouse-set-point event) (let ((e (extent-at (point) nil 'find-function-symbol))) - (if (and-fboundp #'find-function e) - (with-fboundp #'find-function + (if (and-fboundp 'find-function e) + (with-fboundp 'find-function (find-function (extent-property e 'find-function-symbol))) (setq e (extent-at (point) nil 'find-variable-symbol)) - (if (and-fboundp #'find-variable e) - (with-fboundp #'find-variable + (if (and-fboundp 'find-variable e) + (with-fboundp 'find-variable (find-variable (extent-property e 'find-variable-symbol))) (mouse-track event)))))
--- a/lisp/info.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/info.el Thu Mar 17 23:42:59 2011 +0100 @@ -588,7 +588,7 @@ (equal (nth 1 p) "info") (not Info-standalone) (setq Info-standalone t) - (= (length p) 3) + (eql (length p) 3) (not (string-match "^-" (nth 2 p))) (setq file (nth 2 p)) (setq command-line-args-left nil)) @@ -1125,7 +1125,7 @@ (let ((dir-mod-time (nth 5 (file-attributes file))) f-mod-time newer) (setq Info-dir-newer-info-files nil) - (mapcar + (mapc #'(lambda (f) (prog2 (setq f-mod-time (nth 5 (file-attributes f))) @@ -1189,23 +1189,23 @@ (let ((tab-width 8) (description-col 0) len) - (mapcar #'(lambda (e) - (setq e (cdr e)) ; Drop filename - (setq len (length (concat (car e) - (car (cdr e))))) - (if (> len description-col) - (setq description-col len))) - entries) + (mapc #'(lambda (e) + (setq e (cdr e)) ; Drop filename + (setq len (length (concat (car e) + (car (cdr e))))) + (if (> len description-col) + (setq description-col len))) + entries) (setq description-col (+ 5 description-col)) - (mapcar #'(lambda (e) - (setq e (cdr e)) ; Drop filename - (insert "* " (car e) ":" (car (cdr e))) - (setq e (car (cdr (cdr e)))) - (while e - (indent-to-column description-col) - (insert (car e) "\n") - (setq e (cdr e)))) - entries) + (mapc #'(lambda (e) + (setq e (cdr e)) ; Drop filename + (insert "* " (car e) ":" (car (cdr e))) + (setq e (car (cdr (cdr e)))) + (while e + (indent-to-column description-col) + (insert (car e) "\n") + (setq e (cdr e)))) + entries) (insert "\n"))) @@ -1297,7 +1297,7 @@ (narrow-to-region mark next-section) (setq dir-section-contents (nreverse (Info-parse-dir-entries (point-min) (point-max)))) - (mapcar + (mapc #'(lambda (file) (setq dir-entry (assoc (downcase (file-name-sans-extension
--- a/lisp/isearch-mode.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/isearch-mode.el Thu Mar 17 23:42:59 2011 +0100 @@ -237,10 +237,18 @@ (let ((map (make-keymap))) (set-keymap-name map 'isearch-mode-map) - ;; Bind all printing characters to `isearch-printing-char'. - ;; This isn't normally necessary, but if a printing character were - ;; bound to something other than self-insert-command in global-map, - ;; then it would terminate the search and be executed without this. + ;; Bind ASCII printing characters to `isearch-printing-char'. This + ;; isn't normally necessary, but if a printing character were bound to + ;; something other than self-insert-command in global-map, then it would + ;; terminate the search and be executed without this. + + ;; This is also relevant when other modes (notably dired and gnus) call + ;; `suppress-keymap' on their major mode maps; this means that + ;; `isearch-maybe-frob-keyboard-macros' won't pick up that the command + ;; that would normally be executed is `self-insert-command' and do its + ;; thing of transforming that to `isearch-printing-char'. This is less + ;; of an issue for the non-ASCII characters, because they rarely have + ;; specific bindings in major modes. (let ((i 32) (str (make-string 1 0))) (while (< i 127) @@ -711,7 +719,7 @@ nonincremental search instead via `isearch-edit-string'." (interactive) (if (and (or search-nonincremental-instead executing-kbd-macro) - (= 0 (length isearch-string))) + (eql 0 (length isearch-string))) (let ((isearch-nonincremental t) ;; Highlighting only gets in the way of nonincremental ;; search. @@ -825,7 +833,7 @@ isearch-word isearch-new-word)) ;; Empty isearch-string means use default. - (if (= 0 (length isearch-string)) + (if (eql 0 (length isearch-string)) (setq isearch-string (or (car (if isearch-regexp regexp-search-ring search-ring)) @@ -1122,7 +1130,7 @@ (while (and (> idx 0) (eq (aref isearch-string (1- idx)) ?\\)) (setq idx (1- idx))) - (when (= (mod (- (length isearch-string) idx) 2) 0) + (when (eql (mod (- (length isearch-string) idx) 2) 0) (setq isearch-adjusted t) ;; Get the isearch-other-end from before the last search. ;; We want to start from there, @@ -1314,7 +1322,7 @@ ;; isearch-string stays the same t) ((or completion ; not nil, must be a string - (= 0 (length isearch-string))) ; shouldn't have to say this + (eql 0 (length isearch-string))) ; shouldn't have to say this (if (equal completion isearch-string) ;; no extension? (progn (if completion-auto-help @@ -1607,8 +1615,27 @@ 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))))))) + ;;;======================================================== ;;; Highlighting
--- a/lisp/ldap.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/ldap.el Thu Mar 17 23:42:59 2011 +0100 @@ -399,7 +399,7 @@ (defun ldap-encode-country-string (str) ;; We should do something useful here... - (if (not (= 2 (length str))) + (if (not (eql 2 (length str))) (error "Invalid country string: %s" str))) (defun ldap-decode-string (str)
--- a/lisp/menubar-items.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/menubar-items.el Thu Mar 17 23:42:59 2011 +0100 @@ -260,7 +260,7 @@ (submenu-generate-accelerator-spec (mapcar #'(lambda (bmk) `[,bmk (bookmark-delete ',bmk)]) - (bookmark-all-names))))) + (declare-fboundp (bookmark-all-names)))))) ["%_Edit Bookmark List" bookmark-bmenu-list :active (and-boundp 'bookmark-alist bookmark-alist)] "---"
--- a/lisp/minibuf.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/minibuf.el Thu Mar 17 23:42:59 2011 +0100 @@ -1819,10 +1819,10 @@ (completion-ignore-case (file-system-ignore-case-p (or dir default-directory))) (env (substring string - (cond ((= start (length string)) + (cond ((eql start (length string)) ;; "...$" start) - ((= (aref string start) ?{) + ((eql (aref string start) ?{) ;; "...${..." (1+ start)) (t @@ -2093,7 +2093,7 @@ ;; any more. --ben (lambda () (mouse-rfn-setup-vars prompt) - (when-boundp #'scrollbar-width + (when-boundp 'scrollbar-width (set-specifier scrollbar-width 0 (current-buffer))) (setq truncate-lines t)))) @@ -2209,7 +2209,7 @@ "Read a non-nil coding-system from the minibuffer. Prompt with string PROMPT." (let ((retval (intern ""))) - (while (= 0 (length (symbol-name retval))) + (while (eql 0 (length (symbol-name retval))) (setq retval (intern (completing-read prompt obarray 'find-coding-system t)))) @@ -2345,7 +2345,7 @@ (single-key-description event)) (ding nil 'y-or-n-p) (discard-input) - (if (= (length pre) 0) + (if (eql (length pre) 0) (setq pre (format "Please answer %s. " ;; 17 parens! a record in ;; our lisp code.
--- a/lisp/mouse.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/mouse.el Thu Mar 17 23:42:59 2011 +0100 @@ -1770,7 +1770,8 @@ ;; left window side has slipped (right side cannot be ;; moved any further to the right, so enlarge-window ;; plays bad games with the left edge. - (if (or (/= (count-windows) (length old-edges-all-windows)) + (if (or (not (eql (count-windows) + (length old-edges-all-windows))) (/= old-left (car (window-pixel-edges window))) ;; This check is very hairy. We allow any number ;; of left edges to change, but only to the same @@ -1778,22 +1779,24 @@ (let ((all-that-bad nil) (new-left-ok nil) (new-right-ok nil)) - (mapcar* (lambda (window old-edges) - (let ((new (car (window-pixel-edges window)))) - (if (/= new (car old-edges)) - (if (and new-left-ok - (/= new-left-ok new)) - (setq all-that-bad t) - (setq new-left-ok new))))) - (window-list) old-edges-all-windows) - (mapcar* (lambda (window old-edges) - (let ((new (caddr (window-pixel-edges window)))) - (if (/= new (caddr old-edges)) - (if (and new-right-ok - (/= new-right-ok new)) - (setq all-that-bad t) - (setq new-right-ok new))))) - (window-list) old-edges-all-windows) + (mapc (lambda (window old-edges) + (let ((new + (car (window-pixel-edges window)))) + (if (/= new (car old-edges)) + (if (and new-left-ok + (/= new-left-ok new)) + (setq all-that-bad t) + (setq new-left-ok new))))) + (window-list) old-edges-all-windows) + (mapc (lambda (window old-edges) + (let ((new + (caddr (window-pixel-edges window)))) + (if (/= new (caddr old-edges)) + (if (and new-right-ok + (/= new-right-ok new)) + (setq all-that-bad t) + (setq new-right-ok new))))) + (window-list) old-edges-all-windows) all-that-bad)) (set-window-configuration backup-conf)))))))))
--- a/lisp/mule/ccl.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/mule/ccl.el Thu Mar 17 23:42:59 2011 +0100 @@ -471,7 +471,7 @@ ;; If READ-FLAG is non-nil, this statement has the form ;; `(read-if (REG OPERATOR ARG) TRUE-PART FALSE-PART)'. (defun ccl-compile-if (cmd &optional read-flag) - (if (and (/= (length cmd) 3) (/= (length cmd) 4)) + (if (and (not (<= 3 (length cmd) 4))) (error "CCL: Invalid number of arguments: %s" cmd)) (let ((condition (nth 1 cmd)) (true-cmds (nth 2 cmd)) @@ -644,7 +644,7 @@ ;; Compile BREAK statement. (defun ccl-compile-break (cmd) - (if (/= (length cmd) 1) + (if (not (eql (length cmd) 1)) (error "CCL: Invalid number of arguments: %s" cmd)) (if (null ccl-loop-head) (error "CCL: No outer loop: %s" cmd)) @@ -654,7 +654,7 @@ ;; Compile REPEAT statement. (defun ccl-compile-repeat (cmd) - (if (/= (length cmd) 1) + (if (not (eql (length cmd) 1)) (error "CCL: Invalid number of arguments: %s" cmd)) (if (null ccl-loop-head) (error "CCL: No outer loop: %s" cmd)) @@ -663,7 +663,7 @@ ;; Compile WRITE-REPEAT statement. (defun ccl-compile-write-repeat (cmd) - (if (/= (length cmd) 2) + (if (not (eql (length cmd) 2)) (error "CCL: Invalid number of arguments: %s" cmd)) (if (null ccl-loop-head) (error "CCL: No outer loop: %s" cmd)) @@ -781,7 +781,7 @@ ;; Compile CALL statement. (defun ccl-compile-call (cmd) - (if (/= (length cmd) 2) + (if (not (eql (length cmd) 2)) (error "CCL: Invalid number of arguments: %s" cmd)) (if (not (symbolp (nth 1 cmd))) (error "CCL: Subroutine should be a symbol: %s" cmd)) @@ -791,14 +791,14 @@ ;; Compile END statement. (defun ccl-compile-end (cmd) - (if (/= (length cmd) 1) + (if (not (eql (length cmd) 1)) (error "CCL: Invalid number of arguments: %s" cmd)) (ccl-embed-code 'end 0 0) t) ;; Compile read-multibyte-character (defun ccl-compile-read-multibyte-character (cmd) - (if (/= (length cmd) 3) + (if (not (eql (length cmd) 3)) (error "CCL: Invalid number of arguments: %s" cmd)) (let ((RRR (nth 1 cmd)) (rrr (nth 2 cmd))) @@ -809,7 +809,7 @@ ;; Compile write-multibyte-character (defun ccl-compile-write-multibyte-character (cmd) - (if (/= (length cmd) 3) + (if (not (eql (length cmd) 3)) (error "CCL: Invalid number of arguments: %s" cmd)) (let ((RRR (nth 1 cmd)) (rrr (nth 2 cmd))) @@ -820,7 +820,7 @@ ;; Compile translate-character (defun ccl-compile-translate-character (cmd) - (if (/= (length cmd) 4) + (if (not (eql (length cmd) 4)) (error "CCL: Invalid number of arguments: %s" cmd)) (let ((Rrr (nth 1 cmd)) (RRR (nth 2 cmd)) @@ -838,7 +838,7 @@ ;; Compile mule-to-unicode (defun ccl-compile-mule-to-unicode (cmd) - (if (/= (length cmd) 3) + (if (not (eql (length cmd) 3)) (error "CCL: Invalid number of arguments: %s" cmd)) (let ((RRR (nth 1 cmd)) (rrr (nth 2 cmd))) @@ -850,7 +850,7 @@ ;; Given a Unicode code point in register rrr, write the charset ID of the ;; corresponding character in RRR, and the Mule-CCL form of its code in rrr. (defun ccl-compile-unicode-to-mule (cmd) - (if (/= (length cmd) 3) + (if (not (eql (length cmd) 3)) (error "CCL: Invalid number of arguments: %s" cmd)) (let ((rrr (nth 1 cmd)) (RRR (nth 2 cmd))) @@ -861,7 +861,7 @@ ;; Compile lookup-integer (defun ccl-compile-lookup-integer (cmd) - (if (/= (length cmd) 4) + (if (not (eql (length cmd) 4)) (error "CCL: Invalid number of arguments: %s" cmd)) (let ((Rrr (nth 1 cmd)) (RRR (nth 2 cmd)) @@ -881,7 +881,7 @@ ;; Compile lookup-character (defun ccl-compile-lookup-character (cmd) - (if (/= (length cmd) 4) + (if (not (eql (length cmd) 4)) (error "CCL: Invalid number of arguments: %s" cmd)) (let ((Rrr (nth 1 cmd)) (RRR (nth 2 cmd)) @@ -904,7 +904,7 @@ nil) (defun ccl-compile-map-multiple (cmd) - (if (/= (length cmd) 4) + (if (not (eql (length cmd) 4)) (error "CCL: Invalid number of arguments: %s" cmd)) (let (func arg) (setq func @@ -930,7 +930,7 @@ nil) (defun ccl-compile-map-single (cmd) - (if (/= (length cmd) 4) + (if (not (eql (length cmd) 4)) (error "CCL: Invalid number of arguments: %s" cmd)) (let ((RRR (nth 1 cmd)) (rrr (nth 2 cmd)) @@ -1560,4 +1560,4 @@ (provide 'ccl) -;; ccl.el ends her +;; ccl.el ends here
--- a/lisp/mule/devan-util.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/mule/devan-util.el Thu Mar 17 23:42:59 2011 +0100 @@ -1055,8 +1055,7 @@ (setq ordered-glyphs (append ordered-glyphs (list (assq glyph devanagari-composition-rules)))))) - (sort ordered-glyphs #'(lambda (x y) (< (car (cdr x)) (car (cdr y))))))) - + (sort* ordered-glyphs '< :key 'cadr))) ;;(devanagari-compose-to-one-glyph "$(5"5!X![(B") => "4$(6!Xv#"5t%![0!X"5![1(B" (defun devanagari-compose-to-one-glyph (devanagari-string) @@ -1077,7 +1076,7 @@ ;; Before applying compose-chars, convert glyphs to ;; 1-column width if possible. (setq cmp-glyph-list (devanagari-wide-to-narrow cmp-glyph-list)) - (if (= (length cmp-glyph-list) 1) (char-to-string (car cmp-glyph-list)) + (if (eql (length cmp-glyph-list) 1) (char-to-string (car cmp-glyph-list)) (apply 'compose-chars cmp-glyph-list)))) (defun devanagari-composition-component (string &optional start end)
--- a/lisp/mule/japanese.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/mule/japanese.el Thu Mar 17 23:42:59 2011 +0100 @@ -442,44 +442,38 @@ ;; little helps there.) (set-language-info "Japanese" 'native-coding-system - (list - ;; first, see if an explicit encoding was given. - (lambda (locale) - (let ((case-fold-search t)) - (cond - ;; many unix versions - ((string-match "\\.euc" locale) 'euc-jp) - ((string-match "\\.sjis" locale) 'shift-jis) - - ;; X11R6 (CJKV p. 471) - ((string-match "\\.jis7" locale) 'jis7) - ((string-match "\\.jis8" locale) 'jis8) - ((string-match "\\.mscode" locale) 'shift-jis) - ((string-match "\\.pjis" locale) 'iso-2022-jp) - ((string-match "\\.ujis" locale) 'euc-jp) + ;; first, see if an explicit encoding was given. + (lambda (locale) + (let ((case-fold-search t)) + (cond + ;; many unix versions + ((string-match "\\.euc" locale) 'euc-jp) + ((string-match "\\.sjis" locale) 'shift-jis) - ;; other names in X11R6 locale.alias - ((string-match "\\.ajec" locale) 'euc-jp) - ((string-match "-euc" locale) 'euc-jp) - ((string-match "\\.iso-2022-jp" locale) 'iso-2022-jp) - ((string-match "\\.jis" locale) 'jis7) ;; or just jis? - ))) + ;; X11R6 (CJKV p. 471) + ((string-match "\\.jis7" locale) 'jis7) + ((string-match "\\.jis8" locale) 'jis8) + ((string-match "\\.mscode" locale) 'shift-jis) + ((string-match "\\.pjis" locale) 'iso-2022-jp) + ((string-match "\\.ujis" locale) 'euc-jp) - ;; aix (CJKV p. 465) - (lambda (locale) - (when (eq system-type 'aix) - (cond - ((string-match "^Ja_JP" locale) 'shift-jis) - ((string-match "^ja_JP" locale) 'euc-jp)))) + ;; other names in X11R6 locale.alias + ((string-match "\\.ajec" locale) 'euc-jp) + ((string-match "-euc" locale) 'euc-jp) + ((string-match "\\.iso-2022-jp" locale) 'iso-2022-jp) + ((string-match "\\.jis" locale) 'jis7) ;; or just jis? - ;; other X11R6 locale.alias - (lambda (locale) - (cond + ;; aix (CJKV p. 465) + ((and (eq system-type 'aix) + (string-match "^Ja_JP" locale)) 'shift-jis) + ((and (eq system-type 'aix) + (string-match "^ja_JP" locale)) 'euc-jp) + + ;; other X11R6 locale.alias ((string-match "^Jp_JP" locale) 'euc-jp) ((and (eq system-type 'hpux) (eq locale "japanese")) - 'shift-jis))) - - ;; fallback - 'euc-jp)) + 'shift-jis) + ;; fallback + (t 'euc-jp))))) ;;; japanese.el ends here
--- a/lisp/mule/make-coding-system.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/mule/make-coding-system.el Thu Mar 17 23:42:59 2011 +0100 @@ -66,10 +66,7 @@ (repeat)))) nil)) (first-part compiled) (last-part - (member-if-not (lambda (entr) (eq #xBFFE entr)) - (member-if - (lambda (entr) (eq #xBFFE entr)) - first-part)))) + (member* #xBFFE (member* #xBFFE first-part) :test-not 'eql))) (while compiled (when (eq #xBFFE (cadr compiled)) (assert (= vec-len (search '(#xBFFE) (cdr compiled)
--- a/lisp/mule/mule-category.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/mule/mule-category.el Thu Mar 17 23:42:59 2011 +0100 @@ -62,11 +62,7 @@ (defun defined-category-list () "Return a list of the currently defined categories. Categories are given by their designators." - (let (list) - (maphash #'(lambda (key value) - (setq list (cons key list))) - defined-category-hashtable) - (nreverse list))) + (hash-table-key-list defined-category-hashtable)) (defun undefined-category-designator () "Return an undefined category designator, or nil if there are none."
--- a/lisp/mule/mule-cmds.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/mule/mule-cmds.el Thu Mar 17 23:42:59 2011 +0100 @@ -777,7 +777,7 @@ #'(lambda (key entry) (setq string (decode-coding-string (string entry) invalid-sequence-coding-system)) - (when (= 1 (length string)) + (when (eql 1 (length string)) ;; Treat Unicode error sequence chars as the octets ;; corresponding to those on disk: (setq unicode-error-lookup
--- a/lisp/mule/viet-util.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/mule/viet-util.el Thu Mar 17 23:42:59 2011 +0100 @@ -43,8 +43,8 @@ (if (eq char ?~) char (setq char (encode-coding-string char 'viscii)) - (if (and (= 1 (length char)) - (not (eq (aref char 0) ?~))) + (if (and (eql 1 (length char)) + (not (eql (aref char 0) ?~))) (aref char 0)))) ;; VIQR is a menmonic encoding specification for Vietnamese.
--- a/lisp/multicast.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/multicast.el Thu Mar 17 23:42:59 2011 +0100 @@ -85,8 +85,8 @@ ;; We check only the general form of the multicast address. ;; The rest will be handled by the internal function. (string-match "^\\([0-9\\.]+\\)/\\([0-9]+\\)/\\([0-9]+\\)$" address) - (and (not (and (= (match-beginning 0) 0) - (= (match-end 0) (length address)))) + (and (not (and (eql (match-beginning 0) 0) + (eql (match-end 0) (length address)))) (error "malformed multicast address: %s" address)) (and (not (setq dest (match-string 1 address))) (error "invalid destination specification."))
--- a/lisp/newcomment.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/newcomment.el Thu Mar 17 23:42:59 2011 +0100 @@ -282,7 +282,7 @@ (goto-char (match-beginning 0)) (forward-char 1) (if unp (delete-char 1) (insert "\\")) - (when (= (length ce) 1) + (when (eql (length ce) 1) ;; If the comment-end is a single char, adding a \ after that ;; "first" char won't deactivate it, so we turn such a CE ;; into !CS. I.e. for pascal, we turn } into !{ @@ -920,7 +920,7 @@ ((consp arg) (uncomment-region beg end)) ((< numarg 0) (uncomment-region beg end (- numarg))) (t - (setq numarg (if (and (null arg) (= (length comment-start) 1)) + (setq numarg (if (and (null arg) (eql (length comment-start) 1)) add (1- numarg))) (comment-region-internal beg end @@ -977,7 +977,7 @@ ;; specified, calling comment-kill is not very clever. (if arg (comment-kill (and (integerp arg) arg)) (comment-indent)) (let ((add (if arg (prefix-numeric-value arg) - (if (= (length comment-start) 1) comment-add 0)))) + (if (eql (length comment-start) 1) comment-add 0)))) ;; Some modes insist on keeping column 0 comment in column 0 ;; so we need to move away from it before inserting the comment. (indent-according-to-mode)
--- a/lisp/obsolete.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/obsolete.el Thu Mar 17 23:42:59 2011 +0100 @@ -400,7 +400,7 @@ "Return a list of charsets in the STRING except ascii. It might be available for compatibility with Mule 2.3, because its `find-charset-string' ignores ASCII charset." - (delq 'ascii (and-fboundp #'charsets-in-string (charsets-in-string string)))) + (delq 'ascii (and-fboundp 'charsets-in-string (charsets-in-string string)))) (make-obsolete 'find-non-ascii-charset-string "use (delq 'ascii (charsets-in-string STRING)) instead.") @@ -408,7 +408,7 @@ "Return a list of charsets except ascii in the region between START and END. It might be available for compatibility with Mule 2.3, because its `find-charset-string' ignores ASCII charset." - (delq 'ascii (and-fboundp #'charsets-in-region + (delq 'ascii (and-fboundp 'charsets-in-region (charsets-in-region start end)))) (make-obsolete 'find-non-ascii-charset-region "use (delq 'ascii (charsets-in-region START END)) instead.")
--- a/lisp/occur.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/occur.el Thu Mar 17 23:42:59 2011 +0100 @@ -467,7 +467,7 @@ (if (and keep-props (if-boundp 'jit-lock-mode jit-lock-mode) (text-property-not-all begpt endpt 'fontified t)) - (if-fboundp #'jit-lock-fontify-now + (if-fboundp 'jit-lock-fontify-now (jit-lock-fontify-now begpt endpt))) (setq curstring (buffer-substring begpt endpt)) ;; Depropertize the string, and maybe
--- a/lisp/package-ui.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/package-ui.el Thu Mar 17 23:42:59 2011 +0100 @@ -433,9 +433,7 @@ (save-window-excursion (with-output-to-temp-buffer tmpbuf (display-completion-list (sort - (mapcar #'(lambda (pkg) - (symbol-name pkg)) - dependencies) + (mapcar #'symbol-name dependencies) 'string<) :activate-callback nil :help-string "Required packages:\n"
--- a/lisp/packages.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/packages.el Thu Mar 17 23:42:59 2011 +0100 @@ -515,9 +515,7 @@ (load file-name) ;; dumped-lisp.el could have set this ... (if package-lisp - (mapcar #'(lambda (base) - (funcall handle base)) - package-lisp)))))) + (mapcar handle package-lisp)))))) package-load-path)) (defun packages-load-package-dumped-lisps (package-load-path)
--- a/lisp/paragraphs.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/paragraphs.el Thu Mar 17 23:42:59 2011 +0100 @@ -316,7 +316,7 @@ (forward-char 1)) (if (< (point) (point-max)) (goto-char start)))) - (if-fboundp #'constrain-to-field + (if-fboundp 'constrain-to-field (constrain-to-field nil opoint t) (error 'void-function @@ -435,7 +435,7 @@ (skip-chars-backward " \t\n") (goto-char par-end))) (setq arg (1- arg))) - (if-fboundp #'constrain-to-field + (if-fboundp 'constrain-to-field (constrain-to-field nil opoint t) (error 'void-function
--- a/lisp/regexp-opt.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/regexp-opt.el Thu Mar 17 23:42:59 2011 +0100 @@ -173,23 +173,23 @@ (cond ;; ;; If there are no strings, just return the empty string. - ((= (length strings) 0) + ((eql (length strings) 0) "") ;; ;; If there is only one string, just return it. - ((= (length strings) 1) - (if (= (length (car strings)) 1) + ((eql (length strings) 1) + (if (eql (length (car strings)) 1) (concat open-charset (regexp-quote (car strings)) close-charset) (concat open-group (regexp-quote (car strings)) close-group))) ;; ;; If there is an empty string, remove it and recurse on the rest. - ((= (length (car strings)) 0) + ((eql (length (car strings)) 0) (concat open-charset (regexp-opt-group (cdr strings) t t) "?" close-charset)) ;; ;; If all are one-character strings, just return a character set. - ((= (length strings) (apply '+ (mapcar 'length strings))) + ((eql (length strings) (apply '+ (mapcar 'length strings))) (concat open-charset (regexp-opt-charset strings) close-charset))
--- a/lisp/replace.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/replace.el Thu Mar 17 23:42:59 2011 +0100 @@ -151,7 +151,7 @@ (let (replacements) (if (listp to-strings) (setq replacements to-strings) - (while (/= (length to-strings) 0) + (while (not (eql (length to-strings) 0)) (if (string-match " " to-strings) (setq replacements (append replacements
--- a/lisp/select.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/select.el Thu Mar 17 23:42:59 2011 +0100 @@ -36,10 +36,11 @@ ;; Mozilla will happily give us broken COMPOUND_TEXT where a non-broken ;; UTF8_STRING is available. (defvar selection-preferred-types - (let ((res '(UTF8_STRING COMPOUND_TEXT STRING image/png image/gif - image/jpeg image/tiff image/xpm image/xbm))) - (unless (featurep 'mule) (delq 'COMPOUND_TEXT res)) - res) + `(UTF8_STRING ,@(and (featurep 'mule) '(COMPOUND_TEXT)) STRING + ,@(mapcan #'(lambda (format) + (and (featurep format) + (list (intern (format "image/%s" format))))) + '(png gif jpeg tiff xpm xbm))) "An ordered list of X11 type atoms for selections we want to receive. We prefer UTF8_STRING over COMPOUND_TEXT, for compatibility with a certain widely-used browser suite, and COMPOUND_TEXT over STRING. (COMPOUND_TEXT @@ -274,7 +275,7 @@ ;; application asserts the selection. This is probably not a big deal. (defun activate-region-as-selection () - (cond ((and-fboundp #'mouse-track-rectangle-p + (cond ((and-fboundp 'mouse-track-rectangle-p (mouse-track-rectangle-p (mouse-track-activate-rectangular-selection)))) ((marker-buffer (mark-marker t)) @@ -346,7 +347,7 @@ (set-extent-property previous-extent 'end-open nil) (cond - ((and-fboundp #'mouse-track-rectangle-p + ((and-fboundp 'mouse-track-rectangle-p (mouse-track-rectangle-p (setq previous-extent (list previous-extent)) (default-mouse-track-next-move-rect start end previous-extent) @@ -377,7 +378,7 @@ (buffer-live-p (marker-buffer (cdr data)))))) (defun cut-copy-clear-internal (mode) - (or (memq mode '(cut copy clear)) (error "unkown mode %S" mode)) + (or (memq mode '(cut copy clear)) (error "unknown mode %S" mode)) (or (selection-owner-p) (error "XEmacs does not own the primary selection")) (setq last-command nil) @@ -775,26 +776,19 @@ (set-extent-end-glyph extent glyph) str))) -;; Could automate defining these functions these with a macro, but damned if -;; I can get that to work. Anyway, this is more readable. - -(defun select-convert-from-image/gif (selection type value) - (if (featurep 'gif) (select-convert-from-image-data 'gif value))) - -(defun select-convert-from-image/jpeg (selection type value) - (if (featurep 'jpeg) (select-convert-from-image-data 'jpeg value))) - -(defun select-convert-from-image/png (selection type value) - (if (featurep 'png) (select-convert-from-image-data 'png value))) - -(defun select-convert-from-image/tiff (selection type value) - (if (featurep 'tiff) (select-convert-from-image-data 'tiff value))) - -(defun select-convert-from-image/xpm (selection type value) - (if (featurep 'xpm) (select-convert-from-image-data 'xpm value))) - -(defun select-convert-from-image/xbm (selection type value) - (if (featurep 'xbm) (select-convert-from-image-data 'xbm value))) +(macrolet + ((create-image-functions (&rest formats) + (cons + 'progn + (mapcar + #'(lambda (format) + `(if (featurep ',format) + (defalias (intern (concat "select-convert-from-image/" + ,(symbol-name format))) + #'(lambda (selection type value) + (select-convert-from-image-data ',format + value))))) formats)))) + (create-image-functions gif jpeg png tiff xpm xbm)) ;;; CF_xxx conversions (defun select-convert-from-cf-text (selection type value) @@ -929,7 +923,7 @@ ;; Types listed here can be selections foreign to XEmacs (setq selection-converter-in-alist - '(; Specific types that get handled by generic converters + `(; Specific types that get handled by generic converters (INTEGER . select-convert-from-integer) (TIMESTAMP . select-convert-from-integer) (LENGTH . select-convert-from-integer) @@ -946,13 +940,12 @@ (text/html . select-convert-from-utf-16-le-text) ; Mozilla (text/_moz_htmlcontext . select-convert-from-utf-16-le-text) (text/_moz_htmlinfo . select-convert-from-utf-16-le-text) - (image/png . select-convert-from-image/png) - (image/gif . select-convert-from-image/gif) - (image/jpeg . select-convert-from-image/jpeg ) - (image/tiff . select-convert-from-image/tiff ) - (image/xpm . select-convert-from-image/xpm) - (image/xbm . select-convert-from-image/xbm) - )) + ,@(loop + for format in '(gif jpeg png tiff xpm xbm) + nconc (if (featurep format) + (list (cons (intern (format "image/%s" format)) + (intern (format "select-convert-from-image/%s" + format)))))))) ;; Types listed here have special coercion functions that can munge ;; other types. This can also be used to add special features - e.g.
--- a/lisp/simple.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/simple.el Thu Mar 17 23:42:59 2011 +0100 @@ -3979,7 +3979,7 @@ (cond (zmacs-region-rectangular-p (setq zmacs-region-extent (list zmacs-region-extent)) - (when-fboundp #'default-mouse-track-next-move-rect + (when-fboundp 'default-mouse-track-next-move-rect (default-mouse-track-next-move-rect start end zmacs-region-extent)) ))
--- a/lisp/specifier.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/specifier.el Thu Mar 17 23:42:59 2011 +0100 @@ -892,7 +892,7 @@ current-device))) (and dev (device-type dev)))) (t devtype-spec)))) - (cond ((= 1 (length okdevs)) (car okdevs)) + (cond ((eql 1 (length okdevs)) (car okdevs)) ((< try-stages 3) nil) ((null okdevs) devtype) ((memq devtype okdevs) devtype)
--- a/lisp/subr.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/subr.el Thu Mar 17 23:42:59 2011 +0100 @@ -1748,8 +1748,9 @@ Ranges and carets are not treated specially. This implementation is in Lisp; do not use it in performance-critical code." (let ((list (delete-duplicates (string-to-list string) :test #'=))) - (when (/= 1 (length list)) ;; No quoting needed in a string of length 1. - (when (eq ?^ (car list)) + (when (not (eql 1 (length list))) ;; No quoting needed in a string of + ;; length 1. + (when (eql ?^ (car list)) (setq list (nconc (cdr list) '(?^)))) (when (memq ?\\ list) (setq list (delq ?\\ list)
--- a/lisp/test-harness.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/test-harness.el Thu Mar 17 23:42:59 2011 +0100 @@ -126,7 +126,7 @@ (defvar test-harness-current-file nil) -(defvar emacs-lisp-file-regexp (purecopy "\\.el\\'") +(defvar emacs-lisp-file-regexp "\\.el\\'" "*Regexp which matches Emacs Lisp source files.") (defconst test-harness-file-summary-template @@ -332,7 +332,7 @@ "Wrap a BODY that consists of tests that are known to trigger an error. This causes messages to be printed on failure indicating that this is expected, and on success indicating that this is unexpected." - (let ((quoted-body (if (= 1 (length body)) + (let ((quoted-body (if (eql 1 (length body)) `(quote ,(car body)) `(quote (progn ,@body))))) `(let ((test-harness-bug-expected t) (test-harness-failure-tag "KNOWN BUG") @@ -399,12 +399,12 @@ (let ((test-assertion assertion) (negated nil)) (when (and (listp test-assertion) - (= 2 (length test-assertion)) + (eql 2 (length test-assertion)) (memq (car test-assertion) '(not null))) (setq test-assertion (cadr test-assertion)) (setq negated t)) (when (and (listp test-assertion) - (= 3 (length test-assertion)) + (eql 3 (length test-assertion)) (member (car test-assertion) '(eq eql equal equalp = string= < <= > >=))) (let* ((test (car test-assertion)) @@ -447,7 +447,7 @@ (cl-assertion-failed nil)))) (defmacro Check-Error (expected-error &rest body) - (let ((quoted-body (if (= 1 (length body)) + (let ((quoted-body (if (eql 1 (length body)) `(quote ,(car body)) `(quote (progn ,@body))))) `(condition-case error-info (progn @@ -467,7 +467,7 @@ (defmacro Check-Error-Message (expected-error expected-error-regexp &rest body) - (let ((quoted-body (if (= 1 (length body)) + (let ((quoted-body (if (eql 1 (length body)) `(quote ,(car body)) `(quote (progn ,@body))))) `(condition-case error-info (progn @@ -496,7 +496,7 @@ ;; Do not use this with Silence-Message. (defmacro Check-Message (expected-message-regexp &rest body) - (let ((quoted-body (if (= 1 (length body)) + (let ((quoted-body (if (eql 1 (length body)) `(quote ,(car body)) `(quote (progn ,@body))))) `(Skip-Test-Unless (fboundp 'defadvice) "can't defadvice" @@ -754,7 +754,7 @@ (if (= unexpected-test-suite-failures 1) "was" "were") unexpected-test-suite-failures (if (= unexpected-test-suite-failures 1) "failure" "failures") - (if (= (length unexpected-test-suite-failure-files) 1) + (if (eql (length unexpected-test-suite-failure-files) 1) "file" "files")) (while unexpected-test-suite-failure-files
--- a/lisp/wid-edit.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/wid-edit.el Thu Mar 17 23:42:59 2011 +0100 @@ -2485,12 +2485,12 @@ (widget-put old :value internal))) ;; Find new choice. (setq current - (cond ((= (length args) 0) + (cond ((eql (length args) 0) nil) - ((= (length args) 1) + ((eql (length args) 1) (nth 0 args)) ((and widget-choice-toggle - (= (length args) 2) + (eql (length args) 2) (memq old args)) (if (eq old (nth 0 args)) (nth 1 args) @@ -3637,7 +3637,7 @@ (widget-get widget :prompt-match) nil initial history))) (if (and (stringp answer) - (not (zerop (length answer)))) + (not (eql (length answer) 0))) answer (error "No value")))) @@ -4029,7 +4029,7 @@ "Prompt for a color." (let* ((tag (widget-apply widget :menu-tag-get)) (answer (read-color (concat tag ": ")))) - (unless (zerop (length answer)) + (unless (eql (length answer) 0) (widget-value-set widget answer) (widget-setup) (widget-apply widget :notify widget event))))
--- a/lisp/window-xemacs.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/window-xemacs.el Thu Mar 17 23:42:59 2011 +0100 @@ -549,7 +549,7 @@ (interactive) (let ((wc (or config (current-window-configuration))) (stack (window-config-stack))) - (if (or (= 0 (undoable-stack-a-length stack)) + (if (or (eql 0 (undoable-stack-a-length stack)) (not (equal (undoable-stack-a-top stack) wc))) (undoable-stack-push stack wc))))
--- a/lisp/window.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/window.el Thu Mar 17 23:42:59 2011 +0100 @@ -583,7 +583,7 @@ (delq frame (visible-frame-list)) window-solitary (if (and (eq default-minibuffer-frame frame) - (= 1 (length (minibuffer-frame-list)))) + (eql 1 (length (minibuffer-frame-list)))) (setq window nil) (delete-frame frame) (setq window-handled t)))
--- a/lisp/x-compose.el Tue Feb 22 22:56:02 2011 +0100 +++ b/lisp/x-compose.el Thu Mar 17 23:42:59 2011 +0100 @@ -916,9 +916,9 @@ (mod-char (and (>= (downcase base-char) ?a) ; only do alphabetics? (<= (downcase base-char) ?z) (lookup-key map (make-string 1 base-char))))) - (when (and (vectorp mod-char) (= (length mod-char) 1)) + (when (and (vectorp mod-char) (eql (length mod-char) 1)) (setq mod-char (aref mod-char 0)) - (if (and (consp mod-char) (= (length mod-char) 1) + (if (and (consp mod-char) (eql (length mod-char) 1) (characterp (car mod-char))) (setq mod-char (car mod-char)))) (if (and mod-char (symbolp mod-char))
--- a/man/ChangeLog Tue Feb 22 22:56:02 2011 +0100 +++ b/man/ChangeLog Thu Mar 17 23:42:59 2011 +0100 @@ -1,3 +1,81 @@ +2011-03-15 Aidan Kehoe <kehoea@parhasard.net> + + * lispref/objects.texi (Character Type): + * lispref/objects.texi (Equality Predicates): + No longer document `old-eq', `old-equal', they haven't been used + in years. + +2011-03-14 Jeff Sparkes <jsparkes@gmail.com> + + * lispref/faces.texi (Faces): Mention `min-colors' as a + face specifier. + +2011-03-01 Aidan Kehoe <kehoea@parhasard.net> + + * lispref/commands.texi (Using Interactive): + * lispref/compile.texi (Eval During Compile): + * lispref/compile.texi (Compiled-Function Objects): + * lispref/control.texi (Sequencing): + * lispref/control.texi (Conditionals): + * lispref/control.texi (Combining Conditions): + * lispref/control.texi (Iteration): + * lispref/control.texi (Catch and Throw): + * lispref/control.texi (Handling Errors): + * lispref/control.texi (Cleanups): + * lispref/display.texi (Temporary Displays): + * lispref/eval.texi (Quoting): + * lispref/eval.texi (Multiple values): + * lispref/frames.texi (Input Focus): + * lispref/functions.texi (Argument List): + * lispref/functions.texi (Defining Functions): + * lispref/functions.texi (Anonymous Functions): + * lispref/internationalization.texi (Level 3 Primitives): + * lispref/internationalization.texi (Domain Specification): + * lispref/intro.texi (A Sample Function Description): + * lispref/intro.texi (A Sample Variable Description): + * lispref/lists.texi (Sets And Lists): + * lispref/macros.texi (Defining Macros): + * lispref/macros.texi (Backquote): + * lispref/positions.texi (Excursions): + * lispref/positions.texi (Narrowing): + * lispref/searching.texi (Saving Match Data): + * lispref/sequences.texi (Sequence Functions): + * lispref/sequences.texi (Array Functions): + * lispref/specifiers.texi (Adding Specifications): + * lispref/variables.texi (Local Variables): + * lispref/variables.texi (Defining Variables): + * lispref/variables.texi (Setting Variables): + * lispref/variables.texi (Default Value): + * lispref/windows.texi (Selecting Windows): + * lispref/windows.texi (Window Configurations): + No longer use @defspec, since we no longer use the term "special + form"; instead use @deffn {Special Operator}. Unfortunately + there's no way in texinfo to redefine @defspec in one place. + +2011-03-01 Aidan Kehoe <kehoea@parhasard.net> + + * cl.texi (Argument Lists): + * cl.texi (Time of Evaluation): + * cl.texi (Type Predicates): + * cl.texi (Assignment): + * cl.texi (Basic Setf): + * cl.texi (Modify Macros): + * cl.texi (Customizing Setf): + * cl.texi (Dynamic Bindings): + * cl.texi (Lexical Bindings): + * cl.texi (Function Bindings): + * cl.texi (Macro Bindings): + * cl.texi (Conditionals): + * cl.texi (Blocks and Exits): + * cl.texi (Iteration): + * cl.texi (Loop Basics): + * cl.texi (Macros): + * cl.texi (Declarations): + * cl.texi (Property Lists): + * cl.texi (Structures): + * cl.texi (Assertions): + * cl.texi (Efficiency Concerns): + 2011-02-19 Aidan Kehoe <kehoea@parhasard.net> * lispref/lists.texi (Sets And Lists):
--- a/man/cl.texi Tue Feb 22 22:56:02 2011 +0100 +++ b/man/cl.texi Thu Mar 17 23:42:59 2011 +0100 @@ -381,14 +381,14 @@ Instead, this package defines alternates for several Lisp forms which you must use if you need Common Lisp argument lists. -@defspec defun* name arglist body... +@deffn {Special Operator} defun* name arglist body... This form is identical to the regular @code{defun} form, except that @var{arglist} is allowed to be a full Common Lisp argument list. Also, the function body is enclosed in an implicit block called @var{name}; @pxref{Blocks and Exits}. -@end defspec - -@defspec defsubst* name arglist body... +@end deffn + +@deffn {Special Operator} defsubst* name arglist body... This is just like @code{defun*}, except that the function that is defined is automatically proclaimed @code{inline}, i.e., calls to it may be expanded into in-line code by the byte compiler. @@ -398,9 +398,9 @@ efficient inline expansions. In particular, @code{defsubst*} arranges for the processing of keyword arguments, default values, etc., to be done at compile-time whenever possible. -@end defspec - -@defspec defmacro* name arglist body... +@end deffn + +@deffn {Special Operator} defmacro* name arglist body... This is identical to the regular @code{defmacro} form, except that @var{arglist} is allowed to be a full Common Lisp argument list. The @code{&environment} keyword is supported as @@ -409,13 +409,13 @@ cannot be implemented with the current Emacs Lisp interpreter. The macro expander body is enclosed in an implicit block called @var{name}. -@end defspec - -@defspec function* symbol-or-lambda +@end deffn + +@deffn {Special Operator} function* symbol-or-lambda This is identical to the regular @code{function} form, except that if the argument is a @code{lambda} form then that form may use a full Common Lisp argument list. -@end defspec +@end deffn Also, all forms (such as @code{defsetf} and @code{flet}) defined in this package that include @var{arglist}s in their syntax allow @@ -606,7 +606,7 @@ at compile-time so that later parts of the file can refer to the macros that are defined. -@defspec eval-when (situations...) forms... +@deffn {Special Operator} eval-when (situations...) forms... This form controls when the body @var{forms} are evaluated. The @var{situations} list may contain any set of the symbols @code{compile}, @code{load}, and @code{eval} (or their long-winded @@ -678,7 +678,7 @@ certain top-level forms, like @code{defmacro} (sort-of) and @code{require}, as if they were wrapped in @code{(eval-when (compile load eval) @dots{})}. -@end defspec +@end deffn Emacs 19 includes two special operators related to @code{eval-when}. One of these, @code{eval-when-compile}, is not quite equivalent to @@ -690,7 +690,7 @@ equivalent to @samp{(eval-when (compile load eval) @dots{})} and so is not itself defined by this package. -@defspec eval-when-compile forms... +@deffn {Special Operator} eval-when-compile forms... The @var{forms} are evaluated at compile-time; at execution time, this form acts like a quoted constant of the resulting value. Used at top-level, @code{eval-when-compile} is just like @samp{eval-when @@ -699,9 +699,9 @@ or other reasons. This form is similar to the @samp{#.} syntax of true Common Lisp. -@end defspec - -@defspec load-time-value form +@end deffn + +@deffn {Special Operator} load-time-value form The @var{form} is evaluated at load-time; at execution time, this form acts like a quoted constant of the resulting value. @@ -742,7 +742,7 @@ ", and loaded on: " --temp--)) @end example -@end defspec +@end deffn @node Function Aliases, , Time of Evaluation, Program Structure @section Function Aliases @@ -869,7 +869,7 @@ error. @end defun -@defspec deftype name arglist forms... +@deffn {Special Operator} deftype name arglist forms... This macro defines a new type called @var{name}. It is similar to @code{defmacro} in many ways; when @var{name} is encountered as a type name, the body @var{forms} are evaluated and should @@ -897,7 +897,7 @@ The last example shows how the Common Lisp @code{unsigned-byte} type specifier could be implemented if desired; this package does not implement @code{unsigned-byte} by default. -@end defspec +@end deffn The @code{typecase} and @code{check-type} macros also use type names. @xref{Conditionals}. @xref{Assertions}. The @code{map}, @@ -989,7 +989,7 @@ The @code{psetq} form is just like @code{setq}, except that multiple assignments are done in parallel rather than sequentially. -@defspec psetq [symbol form]@dots{} +@deffn {Special Operator} psetq [symbol form]@dots{} This macro is used to assign to several variables simultaneously. Given only one @var{symbol} and @var{form}, it has the same effect as @code{setq}. Given several @var{symbol} @@ -1017,7 +1017,7 @@ @pxref{Modify Macros}.) @code{psetq} always returns @code{nil}. -@end defspec +@end deffn @node Generalized Variables, Variable Bindings, Assignment, Control Structure @section Generalized Variables @@ -1055,7 +1055,7 @@ The @code{setf} macro is the most basic way to operate on generalized variables. -@defspec setf [place form]@dots{} +@deffn {Special Operator} setf [place form]@dots{} This macro evaluates @var{form} and stores it in @var{place}, which must be a valid generalized variable form. If there are several @var{place} and @var{form} pairs, the assignments are done sequentially @@ -1218,7 +1218,7 @@ the form @code{(setf (wrong-order @var{a} @var{b}) 17)} will evaluate @var{b} first, then @var{a}, just as in an actual call to @code{wrong-order}. -@end defspec +@end deffn @node Modify Macros, Customizing Setf, Basic Setf, Generalized Variables @subsection Modify Macros @@ -1228,15 +1228,15 @@ that operate on generalized variables. Many are interesting and useful even when the @var{place} is just a variable name. -@defspec psetf [place form]@dots{} +@deffn {Special Operator} psetf [place form]@dots{} This macro is to @code{setf} what @code{psetq} is to @code{setq}: When several @var{place}s and @var{form}s are involved, the assignments take place in parallel rather than sequentially. Specifically, all subforms are evaluated from left to right, then all the assignments are done (in an undefined order). -@end defspec - -@defspec incf place &optional x +@end deffn + +@deffn {Special Operator} incf place &optional x This macro increments the number stored in @var{place} by one, or by @var{x} if specified. The incremented value is returned. For example, @code{(incf i)} is equivalent to @code{(setq i (1+ i))}, and @@ -1274,35 +1274,35 @@ As a more Emacs-specific example of @code{incf}, the expression @code{(incf (point) @var{n})} is essentially equivalent to @code{(forward-char @var{n})}. -@end defspec - -@defspec decf place &optional x +@end deffn + +@deffn {Special Operator} decf place &optional x This macro decrements the number stored in @var{place} by one, or by @var{x} if specified. -@end defspec - -@defspec pop place +@end deffn + +@deffn {Special Operator} pop place This macro removes and returns the first element of the list stored in @var{place}. It is analogous to @code{(prog1 (car @var{place}) (setf @var{place} (cdr @var{place})))}, except that it takes care to evaluate all subforms only once. -@end defspec - -@defspec push x place +@end deffn + +@deffn {Special Operator} push x place This macro inserts @var{x} at the front of the list stored in @var{place}. It is analogous to @code{(setf @var{place} (cons @var{x} @var{place}))}, except for evaluation of the subforms. -@end defspec - -@defspec pushnew x place @t{&key :test :test-not :key} +@end deffn + +@deffn {Special Operator} pushnew x place @t{&key :test :test-not :key} This macro inserts @var{x} at the front of the list stored in @var{place}, but only if @var{x} was not @code{eql} to any existing element of the list. The optional keyword arguments are interpreted in the same way as for @code{adjoin}. @xref{Lists as Sets}. -@end defspec - -@defspec shiftf place@dots{} newvalue +@end deffn + +@deffn {Special Operator} shiftf place@dots{} newvalue This macro shifts the @var{place}s left by one, shifting in the value of @var{newvalue} (which may be any Lisp expression, not just a generalized variable), and returning the value shifted out of @@ -1320,9 +1320,9 @@ @noindent except that the subforms of @var{a}, @var{b}, and @var{c} are actually evaluated only once each and in the apparent order. -@end defspec - -@defspec rotatef place@dots{} +@end deffn + +@deffn {Special Operator} rotatef place@dots{} This macro rotates the @var{place}s left by one in circular fashion. Thus, @code{(rotatef @var{a} @var{b} @var{c} @var{d})} is equivalent to @@ -1337,12 +1337,12 @@ except for the evaluation of subforms. @code{rotatef} always returns @code{nil}. Note that @code{(rotatef @var{a} @var{b})} conveniently exchanges @var{a} and @var{b}. -@end defspec +@end deffn The following macros were invented for this package; they have no analogues in Common Lisp. -@defspec letf (bindings@dots{}) forms@dots{} +@deffn {Special Operator} letf (bindings@dots{}) forms@dots{} This macro is analogous to @code{let}, but for generalized variables rather than just symbols. Each @var{binding} should be of the form @code{(@var{place} @var{value})}; the original contents of the @@ -1392,14 +1392,14 @@ variables and calls to @code{symbol-value} and @code{symbol-function}. If the symbol is not bound on entry, it is simply made unbound by @code{makunbound} or @code{fmakunbound} on exit. -@end defspec - -@defspec letf* (bindings@dots{}) forms@dots{} +@end deffn + +@deffn {Special Operator} letf* (bindings@dots{}) forms@dots{} This macro is to @code{letf} what @code{let*} is to @code{let}: It does the bindings in sequential rather than parallel order. -@end defspec - -@defspec callf @var{function} @var{place} @var{args}@dots{} +@end deffn + +@deffn {Special Operator} callf @var{function} @var{place} @var{args}@dots{} This is the ``generic'' modify macro. It calls @var{function}, which should be an unquoted function name, macro name, or lambda. It passes @var{place} and @var{args} as arguments, and assigns the @@ -1416,14 +1416,14 @@ @xref{Customizing Setf}, for @code{define-modify-macro}, a way to create even more concise notations for modify macros. Note again that @code{callf} is an extension to standard Common Lisp. -@end defspec - -@defspec callf2 @var{function} @var{arg1} @var{place} @var{args}@dots{} +@end deffn + +@deffn {Special Operator} callf2 @var{function} @var{arg1} @var{place} @var{args}@dots{} This macro is like @code{callf}, except that @var{place} is the @emph{second} argument of @var{function} rather than the first. For example, @code{(push @var{x} @var{place})} is equivalent to @code{(callf2 cons @var{x} @var{place})}. -@end defspec +@end deffn The @code{callf} and @code{callf2} macros serve as building blocks for other macros like @code{incf}, @code{pushnew}, and @@ -1439,7 +1439,7 @@ @code{defsetf}, and @code{define-setf-method}, that allow the user to extend generalized variables in various ways. -@defspec define-modify-macro name arglist function [doc-string] +@deffn {Special Operator} define-modify-macro name arglist function [doc-string] This macro defines a ``read-modify-write'' macro similar to @code{incf} and @code{decf}. The macro @var{name} is defined to take a @var{place} argument followed by additional arguments @@ -1480,9 +1480,9 @@ using @code{get-setf-method}, or consult the source file @file{cl-macs.el} to see how to use the internal @code{setf} building blocks. -@end defspec - -@defspec defsetf access-fn update-fn +@end deffn + +@deffn {Special Operator} defsetf access-fn update-fn This is the simpler of two @code{defsetf} forms. Where @var{access-fn} is the name of a function which accesses a place, this declares @var{update-fn} to be the corresponding store @@ -1525,9 +1525,9 @@ (defsetf symbol-value set) (defsetf buffer-name rename-buffer t) @end example -@end defspec - -@defspec defsetf access-fn arglist (store-var) forms@dots{} +@end deffn + +@deffn {Special Operator} defsetf access-fn arglist (store-var) forms@dots{} This is the second, more complex, form of @code{defsetf}. It is rather like @code{defmacro} except for the additional @var{store-var} argument. The @var{forms} should return a Lisp form which stores @@ -1556,9 +1556,9 @@ (defsetf nth (n x) (store) (list 'setcar (list 'nthcdr n x) store)) @end example -@end defspec - -@defspec define-setf-method access-fn arglist forms@dots{} +@end deffn + +@deffn {Special Operator} define-setf-method access-fn arglist forms@dots{} This is the most general way to create new place forms. When a @code{setf} to @var{access-fn} with arguments described by @var{arglist} is expanded, the @var{forms} are evaluated and @@ -1603,7 +1603,7 @@ use this setf-method will optimize away most temporaries that turn out to be unnecessary, so there is little reason for the setf-method itself to optimize. -@end defspec +@end deffn @defun get-setf-method place &optional env This function returns the setf-method for @var{place}, by @@ -1669,7 +1669,7 @@ at compile-time. The @code{progv} form provides an easy way to bind variables whose names are computed at run-time. -@defspec progv symbols values forms@dots{} +@deffn {Special Operator} progv symbols values forms@dots{} This form establishes @code{let}-style variable bindings on a set of variables computed at run-time. The expressions @var{symbols} and @var{values} are evaluated, and must return lists @@ -1679,7 +1679,7 @@ are made unbound (as if by @code{makunbound}) inside the body. If @var{symbols} is shorter than @var{values}, the excess values are ignored. -@end defspec +@end deffn @node Lexical Bindings, Function Bindings, Dynamic Bindings, Variable Bindings @subsection Lexical Bindings @@ -1688,7 +1688,7 @@ The @dfn{CL} package defines the following macro which more closely follows the Common Lisp @code{let} form: -@defspec lexical-let (bindings@dots{}) forms@dots{} +@deffn {Special Operator} lexical-let (bindings@dots{}) forms@dots{} This form is exactly like @code{let} except that the bindings it establishes are purely lexical. Lexical bindings are similar to local variables in a language like C: Only the code physically @@ -1788,12 +1788,12 @@ The @code{lexical-let} form is an extension to Common Lisp. In true Common Lisp, all bindings are lexical unless declared otherwise. -@end defspec - -@defspec lexical-let* (bindings@dots{}) forms@dots{} +@end deffn + +@deffn {Special Operator} lexical-let* (bindings@dots{}) forms@dots{} This form is just like @code{lexical-let}, except that the bindings are made sequentially in the manner of @code{let*}. -@end defspec +@end deffn @node Function Bindings, Macro Bindings, Lexical Bindings, Variable Bindings @subsection Function Bindings @@ -1802,7 +1802,7 @@ These forms make @code{let}-like bindings to functions instead of variables. -@defspec flet (bindings@dots{}) forms@dots{} +@deffn {Special Operator} flet (bindings@dots{}) forms@dots{} This form establishes @code{let}-style bindings on the function cells of symbols rather than on the value cells. Each @var{binding} must be a list of the form @samp{(@var{name} @var{arglist} @@ -1841,14 +1841,14 @@ argument notation supported by @code{defun*}; also, the function body is enclosed in an implicit block as if by @code{defun*}. @xref{Program Structure}. -@end defspec - -@defspec labels (bindings@dots{}) forms@dots{} +@end deffn + +@deffn {Special Operator} labels (bindings@dots{}) forms@dots{} The @code{labels} form is a synonym for @code{flet}. (In Common Lisp, @code{labels} and @code{flet} differ in ways that depend on their lexical scoping; these distinctions vanish in dynamically scoped Emacs Lisp.) -@end defspec +@end deffn @node Macro Bindings, , Function Bindings, Variable Bindings @subsection Macro Bindings @@ -1856,7 +1856,7 @@ @noindent These forms create local macros and ``symbol macros.'' -@defspec macrolet (bindings@dots{}) forms@dots{} +@deffn {Special Operator} macrolet (bindings@dots{}) forms@dots{} This form is analogous to @code{flet}, but for macros instead of functions. Each @var{binding} is a list of the same form as the arguments to @code{defmacro*} (i.e., a macro name, argument list, @@ -1868,9 +1868,9 @@ affect only calls that appear physically within the body @var{forms}, possibly after expansion of other macros in the body. -@end defspec - -@defspec symbol-macrolet (bindings@dots{}) forms@dots{} +@end deffn + +@deffn {Special Operator} symbol-macrolet (bindings@dots{}) forms@dots{} This form creates @dfn{symbol macros}, which are macros that look like variable references rather than function calls. Each @var{binding} is a list @samp{(@var{var} @var{expansion})}; @@ -1935,7 +1935,7 @@ @xref{Loop Facility}, for a description of the @code{loop} macro. This package defines a nonstandard @code{in-ref} loop clause that works much like @code{my-dolist}. -@end defspec +@end deffn @node Conditionals, Blocks and Exits, Variable Bindings, Control Structure @section Conditionals @@ -1944,7 +1944,7 @@ These conditional forms augment Emacs Lisp's simple @code{if}, @code{and}, @code{or}, and @code{cond} forms. -@defspec when test forms@dots{} +@deffn {Special Operator} when test forms@dots{} This is a variant of @code{if} where there are no ``else'' forms, and possibly several ``then'' forms. In particular, @@ -1958,9 +1958,9 @@ @example (if @var{test} (progn @var{a} @var{b} @var{c}) nil) @end example -@end defspec - -@defspec unless test forms@dots{} +@end deffn + +@deffn {Special Operator} unless test forms@dots{} This is a variant of @code{if} where there are no ``then'' forms, and possibly several ``else'' forms: @@ -1974,9 +1974,9 @@ @example (when (not @var{test}) @var{a} @var{b} @var{c}) @end example -@end defspec - -@defspec case keyform clause@dots{} +@end deffn + +@deffn {Special Operator} case keyform clause@dots{} This macro evaluates @var{keyform}, then compares it with the key values listed in the various @var{clause}s. Whichever clause matches the key is executed; comparison is done by @code{eql}. If no clause @@ -2010,15 +2010,15 @@ ((?\r ?\n) (do-ret-thing)) (t (do-other-thing))) @end example -@end defspec - -@defspec ecase keyform clause@dots{} +@end deffn + +@deffn {Special Operator} ecase keyform clause@dots{} This macro is just like @code{case}, except that if the key does not match any of the clauses, an error is signalled rather than simply returning @code{nil}. -@end defspec - -@defspec typecase keyform clause@dots{} +@end deffn + +@deffn {Special Operator} typecase keyform clause@dots{} This macro is a version of @code{case} that checks for types rather than values. Each @var{clause} is of the form @samp{(@var{type} @var{body}...)}. @xref{Type Predicates}, @@ -2035,13 +2035,13 @@ The type specifier @code{t} matches any type of object; the word @code{otherwise} is also allowed. To make one clause match any of several types, use an @code{(or ...)} type specifier. -@end defspec - -@defspec etypecase keyform clause@dots{} +@end deffn + +@deffn {Special Operator} etypecase keyform clause@dots{} This macro is just like @code{typecase}, except that if the key does not match any of the clauses, an error is signalled rather than simply returning @code{nil}. -@end defspec +@end deffn @node Blocks and Exits, Iteration, Conditionals, Control Structure @section Blocks and Exits @@ -2054,7 +2054,7 @@ optimizing byte-compiler to omit the costly @code{catch} step if the body of the block does not actually @code{return-from} the block. -@defspec block name forms@dots{} +@deffn {Special Operator} block name forms@dots{} The @var{forms} are evaluated as if by a @code{progn}. However, if any of the @var{forms} execute @code{(return-from @var{name})}, they will jump out and return directly from the @code{block} form. @@ -2093,20 +2093,20 @@ that jump to it. This means that @code{do} loops and @code{defun*} functions which don't use @code{return} don't pay the overhead to support it. -@end defspec - -@defspec return-from name [result] +@end deffn + +@deffn {Special Operator} return-from name [result] This macro returns from the block named @var{name}, which must be an (unevaluated) symbol. If a @var{result} form is specified, it is evaluated to produce the result returned from the @code{block}. Otherwise, @code{nil} is returned. -@end defspec - -@defspec return [result] +@end deffn + +@deffn {Special Operator} return [result] This macro is exactly like @code{(return-from nil @var{result})}. Common Lisp loops like @code{do} and @code{dolist} implicitly enclose themselves in @code{nil} blocks. -@end defspec +@end deffn @node Iteration, Loop Facility, Blocks and Exits, Control Structure @section Iteration @@ -2116,7 +2116,7 @@ looping constructs to complement Emacs Lisp's basic @code{while} loop. -@defspec loop forms@dots{} +@deffn {Special Operator} loop forms@dots{} The @dfn{CL} package supports both the simple, old-style meaning of @code{loop} and the extremely powerful and flexible feature known as the @dfn{Loop Facility} or @dfn{Loop Macro}. This more advanced @@ -2144,9 +2144,9 @@ (This is not a restriction in practice, since a plain symbol in the above notation would simply access and throw away the value of a variable.) -@end defspec - -@defspec do (spec@dots{}) (end-test [result@dots{}]) forms@dots{} +@end deffn + +@deffn {Special Operator} do (spec@dots{}) (end-test [result@dots{}]) forms@dots{} This macro creates a general iterative loop. Each @var{spec} is of the form @@ -2192,9 +2192,9 @@ ((or (null x) (null y)) (nreverse z))) @end example -@end defspec - -@defspec do* (spec@dots{}) (end-test [result@dots{}]) forms@dots{} +@end deffn + +@deffn {Special Operator} do* (spec@dots{}) (end-test [result@dots{}]) forms@dots{} This is to @code{do} what @code{let*} is to @code{let}. In particular, the initial values are bound as if by @code{let*} rather than @code{let}, and the steps are assigned as if by @@ -2212,18 +2212,18 @@ (nreverse z)) (push (f x y) z)) @end example -@end defspec - -@defspec dolist (var list [result]) forms@dots{} +@end deffn + +@deffn {Special Operator} dolist (var list [result]) forms@dots{} This is a more specialized loop which iterates across the elements of a list. @var{list} should evaluate to a list; the body @var{forms} are executed with @var{var} bound to each element of the list in turn. Finally, the @var{result} form (or @code{nil}) is evaluated with @var{var} bound to @code{nil} to produce the result returned by the loop. The loop is surrounded by an implicit @code{nil} block. -@end defspec - -@defspec dotimes (var count [result]) forms@dots{} +@end deffn + +@deffn {Special Operator} dotimes (var count [result]) forms@dots{} This is a more specialized loop which iterates a specified number of times. The body is executed with @var{var} bound to the integers from zero (inclusive) to @var{count} (exclusive), in turn. Then @@ -2231,9 +2231,9 @@ number of iterations that were done (i.e., @code{(max 0 @var{count})}) to get the return value for the loop form. The loop is surrounded by an implicit @code{nil} block. -@end defspec - -@defspec do-symbols (var [obarray [result]]) forms@dots{} +@end deffn + +@deffn {Special Operator} do-symbols (var [obarray [result]]) forms@dots{} This loop iterates over all interned symbols. If @var{obarray} is specified and is not @code{nil}, it loops over all symbols in that obarray. For each symbol, the body @var{forms} are evaluated @@ -2241,12 +2241,12 @@ an unspecified order. Afterward the @var{result} form, if any, is evaluated (with @var{var} bound to @code{nil}) to get the return value. The loop is surrounded by an implicit @code{nil} block. -@end defspec - -@defspec do-all-symbols (var [result]) forms@dots{} +@end deffn + +@deffn {Special Operator} do-all-symbols (var [result]) forms@dots{} This is identical to @code{do-symbols} except that the @var{obarray} argument is omitted; it always iterates over the default obarray. -@end defspec +@end deffn @xref{Mapping over Sequences}, for some more functions for iterating over vectors or lists. @@ -2286,7 +2286,7 @@ takes place at byte-compile time; compiled @code{loop}s are just as efficient as the equivalent @code{while} loops written longhand. -@defspec loop clauses@dots{} +@deffn {Special Operator} loop clauses@dots{} A loop construct consists of a series of @var{clause}s, each introduced by a symbol like @code{for} or @code{do}. Clauses are simply strung together in the argument list of @code{loop}, @@ -2325,7 +2325,7 @@ (Because the loop body is enclosed in an implicit block, you can also use regular Lisp @code{return} or @code{return-from} to break out of the loop.) -@end defspec +@end deffn The following sections give some examples of the Loop Macro in action, and describe the particular loop clauses in great detail. @@ -3003,7 +3003,7 @@ Destructuring is made available to the user by way of the following macro: -@defspec destructuring-bind arglist expr forms@dots{} +@deffn {Special Operator} destructuring-bind arglist expr forms@dots{} This macro expands to code which executes @var{forms}, with the variables in @var{arglist} bound to the list of values returned by @var{expr}. The @var{arglist} can include all @@ -3012,13 +3012,13 @@ is not allowed.) The macro expansion will signal an error if @var{expr} returns a list of the wrong number of arguments or with incorrect keyword arguments. -@end defspec +@end deffn This package also includes the Common Lisp @code{define-compiler-macro} facility, which allows you to define compile-time expansions and optimizations for your functions. -@defspec define-compiler-macro name arglist forms@dots{} +@deffn {Special Operator} define-compiler-macro name arglist forms@dots{} This form is similar to @code{defmacro}, except that it only expands calls to @var{name} at compile-time; calls processed by the Lisp interpreter are not expanded, nor are they expanded by the @@ -3052,7 +3052,7 @@ @code{member*} call is left intact. (The actual compiler macro for @code{member*} optimizes a number of other cases, including common @code{:test} predicates.) -@end defspec +@end deffn @defun compiler-macroexpand form This function is analogous to @code{macroexpand}, except that it @@ -3094,7 +3094,7 @@ is evaluated and thus should normally be quoted. @end defun -@defspec declaim decl-specs@dots{} +@deffn {Special Operator} declaim decl-specs@dots{} This macro is like @code{proclaim}, except that it takes any number of @var{decl-spec} arguments, and the arguments are unevaluated and unquoted. The @code{declaim} macro also puts an @code{(eval-when @@ -3103,22 +3103,22 @@ since normally the declarations are meant to influence the way the compiler treats the rest of the file that contains the @code{declaim} form.) -@end defspec - -@defspec declare decl-specs@dots{} +@end deffn + +@deffn {Special Operator} declare decl-specs@dots{} This macro is used to make declarations within functions and other code. Common Lisp allows declarations in various locations, generally at the beginning of any of the many ``implicit @code{progn}s'' throughout Lisp syntax, such as function bodies, @code{let} bodies, etc. Currently the only declaration understood by @code{declare} is @code{special}. -@end defspec - -@defspec locally declarations@dots{} forms@dots{} +@end deffn + +@deffn {Special Operator} locally declarations@dots{} forms@dots{} In this package, @code{locally} is no different from @code{progn}. -@end defspec - -@defspec the type form +@end deffn + +@deffn {Special Operator} the type form Type information provided by @code{the} is ignored in this package; in other words, @code{(the @var{type} @var{form})} is equivalent to @var{form}. Future versions of the optimizing byte-compiler may @@ -3131,7 +3131,7 @@ compiler would have enough information to expand the loop in-line. For now, Emacs Lisp will treat the above code as exactly equivalent to @code{(mapcar 'car foo)}. -@end defspec +@end deffn Each @var{decl-spec} in a @code{proclaim}, @code{declaim}, or @code{declare} should be a list beginning with a symbol that says @@ -3313,7 +3313,7 @@ expression. @end defun -@defspec remf place property +@deffn {Special Operator} remf place property This macro removes the property-value pair for @var{property} from the property list stored at @var{place}, which is any @code{setf}-able place expression. It returns true if the property was found. Note @@ -3321,7 +3321,7 @@ effectively do a @code{(setf @var{place} (cddr @var{place}))}, whereas if it occurs later, this simply uses @code{setcdr} to splice out the property and value cells. -@end defspec +@end deffn @iftex @secno=2 @@ -4677,7 +4677,7 @@ implements structures as vectors (or lists upon request) with a special ``tag'' symbol to identify them. -@defspec defstruct name slots@dots{} +@deffn {Special Operator} defstruct name slots@dots{} The @code{defstruct} form defines a new structure type called @var{name}, with the specified @var{slots}. (The @var{slots} may begin with a string which documents the structure type.) @@ -4984,7 +4984,7 @@ specifies a number of slots to be skipped between the last slot of the included type and the first new slot. @end table -@end defspec +@end deffn Except as noted, the @code{defstruct} facility of this package is entirely compatible with that of Common Lisp. @@ -5007,7 +5007,7 @@ away the following assertions. Because assertions might be optimized away, it is a bad idea for them to include side-effects. -@defspec assert test-form [show-args string args@dots{}] +@deffn {Special Operator} assert test-form [show-args string args@dots{}] This form verifies that @var{test-form} is true (i.e., evaluates to a non-@code{nil} value). If so, it returns @code{nil}. If the test is not satisfied, @code{assert} signals an error. @@ -5030,9 +5030,9 @@ true Common Lisp, the second argument gives a list of @var{places} which can be @code{setf}'d by the user before continuing from the error. -@end defspec - -@defspec check-type place type &optional string +@end deffn + +@deffn {Special Operator} check-type place type &optional string This form verifies that @var{place} evaluates to a value of type @var{type}. If so, it returns @code{nil}. If not, @code{check-type} signals a continuable @code{wrong-type-argument} error. The default @@ -5051,18 +5051,18 @@ should be a @var{place} suitable for use by @code{setf}, because @code{check-type} signals a continuable error that allows the user to modify @var{place}, most simply by returning a value from the debugger. -@end defspec +@end deffn The following error-related macro is also defined: -@defspec ignore-errors forms@dots{} +@deffn {Special Operator} ignore-errors forms@dots{} This executes @var{forms} exactly like a @code{progn}, except that errors are ignored during the @var{forms}. More precisely, if an error is signalled then @code{ignore-errors} immediately aborts execution of the @var{forms} and returns @code{nil}. If the @var{forms} complete successfully, @code{ignore-errors} returns the result of the last @var{form}. -@end defspec +@end deffn @node Efficiency Concerns, Common Lisp Compatibility, Assertions, Top @appendix Efficiency Concerns
--- a/man/lispref/commands.texi Tue Feb 22 22:56:02 2011 +0100 +++ b/man/lispref/commands.texi Thu Mar 17 23:42:59 2011 +0100 @@ -120,7 +120,7 @@ This section describes how to write the @code{interactive} form that makes a Lisp function an interactively-callable command. -@defspec interactive arg-descriptor +@deffn {Special Operator} interactive arg-descriptor @cindex argument descriptors This special operator declares that the function in which it appears is a command, and that it may therefore be called interactively (via @@ -139,7 +139,7 @@ @code{interactive} form are executed, but at this time @code{interactive} simply returns @code{nil} without even evaluating its argument. -@end defspec +@end deffn There are three possibilities for the argument @var{arg-descriptor}:
--- a/man/lispref/compile.texi Tue Feb 22 22:56:02 2011 +0100 +++ b/man/lispref/compile.texi Thu Mar 17 23:42:59 2011 +0100 @@ -691,7 +691,7 @@ These features permit you to write code to be evaluated during compilation of a program. -@defspec eval-and-compile body +@deffn {Special Operator} eval-and-compile body This form marks @var{body} to be evaluated both when you compile the containing code and when you run it (whether compiled or not). @@ -699,9 +699,9 @@ and referring to that file with @code{require}. Using @code{require} is preferable if there is a substantial amount of code to be executed in this way. -@end defspec +@end deffn -@defspec eval-when-compile body +@deffn {Special Operator} eval-when-compile body This form marks @var{body} to be evaluated at compile time and not when the compiled program is loaded. The result of evaluation by the compiler becomes a constant which appears in the compiled program. When @@ -712,7 +712,7 @@ @code{(eval-when (compile eval) @dots{})}. Elsewhere, the Common Lisp @samp{#.} reader macro (but not when interpreting) is closer to what @code{eval-when-compile} does. -@end defspec +@end deffn @node Compiled-Function Objects @section Compiled-Function Objects
--- a/man/lispref/control.texi Tue Feb 22 22:56:02 2011 +0100 +++ b/man/lispref/control.texi Thu Mar 17 23:42:59 2011 +0100 @@ -76,7 +76,7 @@ needed now most often inside an @code{unwind-protect}, @code{and}, @code{or}, or in the @var{then}-part of an @code{if}. -@defspec progn forms@dots{} +@deffn {Special Operator} progn forms@dots{} This special operator evaluates all of the @var{forms}, in textual order, returning the result of the final form. @@ -91,12 +91,12 @@ @result{} "The third form" @end group @end example -@end defspec +@end deffn Two other control constructs likewise evaluate a series of forms but return a different value: -@defspec prog1 form1 forms@dots{} +@deffn {Special Operator} prog1 form1 forms@dots{} This special operator evaluates @var{form1} and all of the @var{forms}, in textual order, returning the result of @var{form1}. @@ -118,9 +118,9 @@ @example (prog1 (car x) (setq x (cdr x))) @end example -@end defspec +@end deffn -@defspec prog2 form1 form2 forms@dots{} +@deffn {Special Operator} prog2 form1 form2 forms@dots{} This special operator evaluates @var{form1}, @var{form2}, and all of the following @var{forms}, in textual order, returning the result of @var{form2}. @@ -136,7 +136,7 @@ @result{} "The second form" @end group @end example -@end defspec +@end deffn @node Conditionals @section Conditionals @@ -146,7 +146,7 @@ has two conditional forms: @code{if}, which is much the same as in other languages, and @code{cond}, which is a generalized case statement. -@defspec if condition then-form else-forms@dots{} +@deffn {Special Operator} if condition then-form else-forms@dots{} @code{if} chooses between the @var{then-form} and the @var{else-forms} based on the value of @var{condition}. If the evaluated @var{condition} is non-@code{nil}, @var{then-form} is evaluated and the result returned. @@ -169,9 +169,9 @@ @result{} very-false @end group @end example -@end defspec +@end deffn -@defspec cond clause@dots{} +@deffn {Special Operator} cond clause@dots{} @code{cond} chooses among an arbitrary number of alternatives. Each @var{clause} in the @code{cond} must be a list. The @sc{car} of this list is the @var{condition}; the remaining elements, if any, the @@ -239,7 +239,7 @@ @noindent This expression is a @code{cond} which returns @code{foo} if the value of @code{a} is 1, and returns the string @code{"default"} otherwise. -@end defspec +@end deffn Any conditional construct can be expressed with @code{cond} or with @code{if}. Therefore, the choice between them is a matter of style. @@ -268,7 +268,7 @@ using the name @code{null} if you are testing for an empty list. @end defun -@defspec and conditions@dots{} +@deffn {Special Operator} and conditions@dots{} The @code{and} special operator tests whether all the @var{conditions} are true. It works by evaluating the @var{conditions} one by one in the order written. @@ -320,9 +320,9 @@ (cond (@var{arg1} (cond (@var{arg2} @var{arg3})))) @end group @end example -@end defspec +@end deffn -@defspec or conditions@dots{} +@deffn {Special Operator} or conditions@dots{} The @code{or} special operator tests whether at least one of the @var{conditions} is true. It works by evaluating all the @var{conditions} one by one in the order written. @@ -369,7 +369,7 @@ This is not completely equivalent because it can evaluate @var{arg1} or @var{arg2} twice. By contrast, @code{(or @var{arg1} @var{arg2} @var{arg3})} never evaluates any argument more than once. -@end defspec +@end deffn @node Iteration @section Iteration @@ -381,7 +381,7 @@ of a list, or once for each integer from 0 to @var{n}. You can do this in XEmacs Lisp with the special operator @code{while}: -@defspec while condition forms@dots{} +@deffn {Special Operator} while condition forms@dots{} @code{while} first evaluates @var{condition}. If the result is non-@code{nil}, it evaluates @var{forms} in textual order. Then it reevaluates @var{condition}, and if the result is non-@code{nil}, it @@ -427,7 +427,7 @@ This moves forward one line and continues moving by lines until it reaches an empty. It is unusual in that the @code{while} has no body, just the end test (which also does the real work of moving point). -@end defspec +@end deffn @node Nonlocal Exits @section Nonlocal Exits @@ -499,15 +499,7 @@ @code{throw} can be used in commands such as @code{exit-recursive-edit} that throw back to the editor command loop (@pxref{Recursive Editing}). -@cindex CL note---only @code{throw} in Emacs -@quotation -@b{Common Lisp note:} Most other versions of Lisp, including Common Lisp, -have several ways of transferring control nonsequentially: @code{return}, -@code{return-from}, and @code{go}, for example. XEmacs Lisp has only -@code{throw}. -@end quotation - -@defspec catch tag body@dots{} +@deffn {Special Operator} catch tag body@dots{} @cindex tag on run time stack @code{catch} establishes a return point for the @code{throw} function. The return point is distinguished from other such return points by @var{tag}, @@ -522,7 +514,7 @@ If a @code{throw} is done within @var{body} specifying the same value @var{tag}, the @code{catch} exits immediately; the value it returns is whatever was specified as the second argument of @code{throw}. -@end defspec +@end deffn @defun throw tag value The purpose of @code{throw} is to return from a return point previously @@ -1028,7 +1020,7 @@ by an error handler (though using @code{throw} when there is no suitable @code{catch} signals an error that can be handled). -@defspec condition-case var protected-form handlers@dots{} +@deffn {Special Operator} condition-case var protected-form handlers@dots{} This special operator establishes the error handlers @var{handlers} around the execution of @var{protected-form}. If @var{protected-form} executes without error, the value it returns becomes the value of the @@ -1077,7 +1069,7 @@ If @var{var} is @code{nil}, that means no variable is bound. Then the error symbol and associated data are not available to the handler. -@end defspec +@end deffn @cindex @code{arith-error} example Here is an example of using @code{condition-case} to handle the error @@ -1252,7 +1244,7 @@ temporarily put a data structure in an inconsistent state; it permits you to ensure the data are consistent in the event of an error or throw. -@defspec unwind-protect body cleanup-forms@dots{} +@deffn {Special Operator} unwind-protect body cleanup-forms@dots{} @cindex cleanup forms @cindex protected forms @cindex error cleanup @@ -1278,7 +1270,7 @@ The number of currently active @code{unwind-protect} forms counts, together with the number of local variable bindings, against the limit @code{max-specpdl-size} (@pxref{Local Variables}). -@end defspec +@end deffn For example, here we make an invisible buffer for temporary use, and make sure to kill it before finishing:
--- a/man/lispref/display.texi Tue Feb 22 22:56:02 2011 +0100 +++ b/man/lispref/display.texi Thu Mar 17 23:42:59 2011 +0100 @@ -720,7 +720,7 @@ and then present it to the user for perusal rather than for editing. Many of the help commands use this feature. -@defspec with-output-to-temp-buffer buffer-name forms@dots{} +@deffn {Special Operator} with-output-to-temp-buffer buffer-name forms@dots{} This function executes @var{forms} while arranging to insert any output they print into the buffer named @var{buffer-name}. The buffer is then shown in some window for viewing, displayed but not selected. @@ -760,7 +760,7 @@ ---------- Buffer: foo ---------- @end group @end example -@end defspec +@end deffn @defvar temp-buffer-show-function If this variable is non-@code{nil}, @code{with-output-to-temp-buffer}
--- a/man/lispref/eval.texi Tue Feb 22 22:56:02 2011 +0100 +++ b/man/lispref/eval.texi Thu Mar 17 23:42:59 2011 +0100 @@ -663,9 +663,9 @@ not necessary to quote self-evaluating objects such as numbers, strings, and vectors.) -@defspec quote object +@deffn {Special Operator} quote object This special operator returns @var{object}, without evaluating it. -@end defspec +@end deffn @cindex @samp{'} for quoting @cindex quoting using apostrophe @@ -743,48 +743,48 @@ values. @end defun -@defspec multiple-value-bind (var@dots{}) values-form forms@dots{} +@deffn {Special Operator} multiple-value-bind (var@dots{}) values-form forms@dots{} This special operator evaluates @var{values-form}, which may return multiple values. It then binds the @var{var}s to these respective values, as if by @code{let}, and then executes the body @var{forms}. If there are more @var{var}s than values, the extra @var{var}s are bound to @code{nil}. If there are fewer @var{var}s than values, the excess values are ignored. -@end defspec +@end deffn -@defspec multiple-value-setq (var@dots{}) form +@deffn {Special Operator} multiple-value-setq (var@dots{}) form This special operator evaluates @var{form}, which may return multiple values. It then sets the @var{var}s to these respective values, as if by @code{setq}. Extra @var{var}s or values are treated the same as in @code{multiple-value-bind}. -@end defspec +@end deffn -@defspec multiple-value-call function forms@dots{} +@deffn {Special Operator} multiple-value-call function forms@dots{} This special operator evaluates function, discarding any multiple values. It then evaluates @var{forms}, preserving any multiple values, and calls @var{function} as a function with the results. Conceptually, this function is a version of @code{apply'}that by-passes the multiple values infrastructure, treating multiple values as intercalated lists. -@end defspec +@end deffn -@defspec multiple-value-list form +@deffn {Special Operator} multiple-value-list form This special operator evaluates @var{form} and returns a list of the multiple values given by it. -@end defspec +@end deffn -@defspec multiple-value-prog1 first body@dots{} +@deffn {Special Operator} multiple-value-prog1 first body@dots{} This special operator evaluates the form @var{first}, then the forms @var{body}. It returns the value given by @var{first}, preserving any multiple values. This is identical to @code{prog1}, except that @code{prog1} always discards multiple values. -@end defspec +@end deffn -@defspec nth-value n form +@deffn {Special Operator} nth-value n form This special operator evaluates @var{form} and returns the @var{n}th value it gave. @var{n} must be an integer of value zero or more. If @var{form} gave insufficient multiple values, @code{nth-value} returns @code{nil}. -@end defspec +@end deffn @defvar multiple-values-limit This constant describes the exclusive upper bound on the number of
--- a/man/lispref/faces.texi Tue Feb 22 22:56:02 2011 +0100 +++ b/man/lispref/faces.texi Thu Mar 17 23:42:59 2011 +0100 @@ -27,7 +27,8 @@ Each built-in property of a face is controlled using a specifier, which allows it to have separate values in particular buffers, frames, windows, and devices and to further vary according to device type -(X or TTY) and device class (color, mono, or grayscale). +(X or TTY), device class (color, mono, or grayscale) and number of +displayable colors (min-colors). @xref{Specifiers}, for more information. The face named @code{default} is used for ordinary text. The face named
--- a/man/lispref/frames.texi Tue Feb 22 22:56:02 2011 +0100 +++ b/man/lispref/frames.texi Thu Mar 17 23:42:59 2011 +0100 @@ -785,18 +785,18 @@ @code{focus-follows-mouse}. @end defun -@defspec save-selected-frame forms@dots{} +@deffn {Special Operator} save-selected-frame forms@dots{} This special operator records the selected frame, executes @var{forms} in sequence, then restores the earlier selected frame. The value returned is the value of the last form. -@end defspec +@end deffn -@defspec with-selected-frame frame forms@dots{} +@deffn {Special Operator} with-selected-frame frame forms@dots{} This special operator records the selected frame, then selects @var{frame} and executes @var{forms} in sequence. After the last form is finished, the earlier selected frame is restored. The value returned is the value of the last form. -@end defspec +@end deffn @ignore (FSF Emacs, continued from defun select-frame) XEmacs cooperates with the X server and the window managers by arranging
--- a/man/lispref/functions.texi Tue Feb 22 22:56:02 2011 +0100 +++ b/man/lispref/functions.texi Thu Mar 17 23:42:59 2011 +0100 @@ -337,8 +337,9 @@ @cindex CL note---default optional arg @quotation @b{Common Lisp note:} Common Lisp allows the function to specify what -default value to use when an optional argument is omitted; XEmacs Lisp -always uses @code{nil}. +default value to use when an optional argument is omitted; this is +available in XEmacs Lisp with the @code{defun*} macro, an alternative to +@code{defun}. @end quotation For example, an argument list that looks like this: @@ -474,7 +475,7 @@ is called @dfn{defining a function}, and it is done with the @code{defun} special operator. -@defspec defun name argument-list body-forms +@deffn {Special Operator} defun name argument-list body-forms @code{defun} is the usual way to define new Lisp functions. It defines the symbol @var{name} as a function that looks like this: @@ -543,7 +544,7 @@ without any hesitation or notification. Redefining a function already defined is often done deliberately, and there is no way to distinguish deliberate redefinition from unintentional redefinition. -@end defspec +@end deffn @defun define-function name definition @defunx defalias name definition @@ -833,14 +834,14 @@ In such cases, we usually use the special operator @code{function} instead of simple quotation to quote the anonymous function. -@defspec function function-object +@deffn {Special Operator} function function-object @cindex function quoting This special operator returns @var{function-object} without evaluating it. In this, it is equivalent to @code{quote}. However, it serves as a note to the XEmacs Lisp compiler that @var{function-object} is intended to be used only as a function, and therefore can safely be compiled. Contrast this with @code{quote}, in @ref{Quoting}. -@end defspec +@end deffn Using @code{function} instead of @code{quote} makes a difference inside a function or macro that you are going to compile. For example:
--- a/man/lispref/internationalization.texi Tue Feb 22 22:56:02 2011 +0100 +++ b/man/lispref/internationalization.texi Thu Mar 17 23:42:59 2011 +0100 @@ -83,7 +83,7 @@ nothing. @end defun -@defspec domain string +@deffn {Special Operator} domain string This function specifies the text domain used for translating documentation strings and interactive prompts of a function. For example, write: @@ -94,7 +94,7 @@ to specify @code{emacs-foo} as the text domain of the function @code{foo}. The ``call'' to @code{domain} is actually a declaration rather than a function; when actually called, @code{domain} just returns @code{nil}. -@end defspec +@end deffn @defun domain-of function This function returns the text domain of @var{function}; it returns @@ -145,19 +145,19 @@ For variables and constants which have documentation strings, specify the domain after the documentation. -@defspec defvar symbol [value [doc-string [domain]]] +@deffn {Special Operator} defvar symbol [value [doc-string [domain]]] Example: @example (defvar weight 250 "Weight of gorilla, in pounds." "emacs-gorilla") @end example -@end defspec +@end deffn -@defspec defconst symbol [value [doc-string [domain]]] +@deffn {Special Operator} defconst symbol [value [doc-string [domain]]] Example: @example (defconst limbs 4 "Number of limbs" "emacs-gorilla") @end example -@end defspec +@end deffn @defun autoload function filename &optional docstring interactive type This function defines @var{function} to autoload from @var{filename}
--- a/man/lispref/intro.texi Tue Feb 22 22:56:02 2011 +0100 +++ b/man/lispref/intro.texi Thu Mar 17 23:42:59 2011 +0100 @@ -787,7 +787,7 @@ arguments. Parentheses are used when several arguments are grouped into additional levels of list structure. Here is an example: -@defspec count-loop (@var{var} [@var{from} @var{to} [@var{inc}]]) @var{body}@dots{} +@deffn {Special Operator} count-loop (@var{var} [@var{from} @var{to} [@var{inc}]]) @var{body}@dots{} This imaginary special operator implements a loop that executes the @var{body} forms and then increments the variable @var{var} on each iteration. On the first iteration, the variable has the value @@ -817,7 +817,7 @@ @var{inc} may optionally be specified as well. These arguments are grouped with the argument @var{var} into a list, to distinguish them from @var{body}, which includes all remaining elements of the form. -@end defspec +@end deffn @node A Sample Variable Description @subsubsection A Sample Variable Description
--- a/man/lispref/lists.texi Tue Feb 22 22:56:02 2011 +0100 +++ b/man/lispref/lists.texi Thu Mar 17 23:42:59 2011 +0100 @@ -1271,7 +1271,7 @@ @end example In the following example, the @code{(4)} that @code{remove*} attempts to match -and the @code{(4)} in the @code{sample-list} are not @code{eq}: +and the @code{(4)} in the @code{sample-list} are not @code{eql}: @example @group
--- a/man/lispref/macros.texi Tue Feb 22 22:56:02 2011 +0100 +++ b/man/lispref/macros.texi Thu Mar 17 23:42:59 2011 +0100 @@ -212,7 +212,7 @@ In practice, almost all Lisp macros have names, and they are usually defined with the special operator @code{defmacro}. -@defspec defmacro name argument-list body-forms@dots{} +@deffn {Special Operator} defmacro name argument-list body-forms@dots{} @code{defmacro} defines the symbol @var{name} as a macro that looks like this: @@ -229,7 +229,7 @@ (@pxref{Argument List}). Macros may have a documentation string, but any @code{interactive} declaration is ignored since macros cannot be called interactively. -@end defspec +@end deffn @node Backquote @section Backquote
--- a/man/lispref/objects.texi Tue Feb 22 22:56:02 2011 +0100 +++ b/man/lispref/objects.texi Thu Mar 17 23:42:59 2011 +0100 @@ -349,19 +349,6 @@ primitive types. (This change was necessary in order for @sc{mule}, i.e. Asian-language, support to be correctly implemented.) - Even in XEmacs version 20, remnants of the equivalence between -characters and integers still exist; this is termed the @dfn{char-int -confoundance disease}. In particular, many functions such as @code{eq}, -@code{equal}, and @code{memq} have equivalent functions (@code{old-eq}, -@code{old-equal}, @code{old-memq}, etc.) that pretend like characters -are integers are the same. Byte code compiled under any version 19 -Emacs will have all such functions mapped to their @code{old-} equivalents -when the byte code is read into XEmacs 20. This is to preserve -compatibility---Emacs 19 converts all constant characters to the equivalent -integer during byte-compilation, and thus there is no other way to preserve -byte-code compatibility even if the code has specifically been written -with the distinction between characters and integers in mind. - Every character has an equivalent integer, called the @dfn{character code}. For example, the character @kbd{A} is represented as the @w{integer 65}, following the standard @sc{ascii} representation of @@ -2317,32 +2304,6 @@ @end defun -@defun old-eq object1 object2 -This function exists under XEmacs 20 and is exactly like @code{eq} -except that it suffers from the char-int confoundance disease. -In other words, it returns @code{t} if given a character and the -equivalent integer, even though the objects are of different types! -You should @emph{not} ever call this function explicitly in your -code. However, be aware that all calls to @code{eq} in byte code -compiled under version 19 map to @code{old-eq} in XEmacs 20. -(Likewise for @code{old-equal}, @code{old-memq}, @code{old-member}, -@code{old-assq} and @code{old-assoc}.) - -@example -@group -;; @r{Remember, this does not apply under XEmacs 19.} -?A - @result{} ?A -(char-int ?A) - @result{} 65 -(old-eq ?A 65) - @result{} t ; @r{Eek, we've been infected.} -(eq ?A 65) - @result{} nil ; @r{We are still healthy.} -@end group -@end example -@end defun - @defun eql object1 object2 This function returns @code{t} if the two arguments are the same object,
--- a/man/lispref/positions.texi Tue Feb 22 22:56:02 2011 +0100 +++ b/man/lispref/positions.texi Thu Mar 17 23:42:59 2011 +0100 @@ -766,7 +766,7 @@ described elsewhere (see @ref{Window Configurations} and @pxref{Frame Configurations}). -@defspec save-excursion forms@dots{} +@deffn {Special Operator} save-excursion forms@dots{} @cindex mark excursion @cindex point excursion @cindex current buffer excursion @@ -810,29 +810,29 @@ (set-marker (mark-marker) old-mark))) @end group @end example -@end defspec +@end deffn -@defspec save-current-buffer forms@dots{} +@deffn {Special Operator} save-current-buffer forms@dots{} This special operator is similar to @code{save-excursion} but it only saves and restores the current buffer. Beginning with XEmacs 20.3, @code{save-current-buffer} is a primitive. -@end defspec +@end deffn -@defspec with-current-buffer buffer forms@dots{} +@deffn {Special Operator} with-current-buffer buffer forms@dots{} This macro evaluates @var{forms} with @var{buffer} as the current buffer. It returns the value of the last form. -@end defspec +@end deffn -@defspec with-temp-file filename forms@dots{} +@deffn {Special Operator} with-temp-file filename forms@dots{} This macro creates a new buffer, evaluates @var{forms} there, and writes the buffer to @var{filename}. It returns the value of the last form evaluated. -@end defspec +@end deffn -@defspec save-selected-window forms@dots{} +@deffn {Special Operator} save-selected-window forms@dots{} This macro is similar to @code{save-excursion} but it saves and restores the selected window and nothing else. -@end defspec +@end deffn @node Narrowing @section Narrowing @@ -893,7 +893,7 @@ @var{buffer} defaults to the current buffer if omitted. @end deffn -@defspec save-restriction body@dots{} +@deffn {Special Operator} save-restriction body@dots{} This special operator saves the current bounds of the accessible portion, evaluates the @var{body} forms, and finally restores the saved bounds, thus restoring the same state of narrowing (or absence thereof) formerly @@ -972,4 +972,4 @@ ---------- Buffer: foo ---------- @end group @end example -@end defspec +@end deffn
--- a/man/lispref/searching.texi Tue Feb 22 22:56:02 2011 +0100 +++ b/man/lispref/searching.texi Thu Mar 17 23:42:59 2011 +0100 @@ -1458,10 +1458,10 @@ You can save and restore the match data with @code{save-match-data}: -@defspec save-match-data body@dots{} +@deffn {Special Operator} save-match-data body@dots{} This special operator executes @var{body}, saving and restoring the match data around it. -@end defspec +@end deffn Emacs automatically saves and restores the match data when it runs process filter functions (@pxref{Filter Functions}) and process
--- a/man/lispref/sequences.texi Tue Feb 22 22:56:02 2011 +0100 +++ b/man/lispref/sequences.texi Thu Mar 17 23:42:59 2011 +0100 @@ -219,6 +219,44 @@ @code{nth} (@pxref{List Elements}). @end defun +@defun fill sequence object @t{&key :start :end} +This function fills the sequence @var{sequence} with @var{object}, so +that each element of @var{sequence} between the indices specified by +@code{:start} (inclusive) and @code{:end} (exclusive), is @var{object}. +It returns @var{sequence}. + +@example +@group +(setq a [a b c d e f g]) + @result{} [a b c d e f g] +(fill a 0 :end 2) + @result{} [0 0 c d e f g] +(fill a 0) + @result{} [0 0 0 0 0 0 0] +a + @result{} [0 0 0 0 0 0 0] +@end group + +@group +(setq s "When in the course") + @result{} "When in the course" +(fill s ?-) + @result{} "------------------" +@end group + +@group +(setq bv #*1101) + @result{} #*1101 +(fill bv 0) + @result{} #*0000 +@end group +@end example + +If @var{sequence} is of a type that cannot hold @var{object} ( +bit-vector can only hold the integers one or zero, strings can only hold +characters) a @code{wrong-type-argument} error results. +@end defun + @node Arrays @section Arrays @cindex array @@ -387,39 +425,6 @@ @code{wrong-type-argument} error results. @end defun -@defun fillarray array object -This function fills the array @var{array} with @var{object}, so that -each element of @var{array} is @var{object}. It returns @var{array}. - -@example -@group -(setq a [a b c d e f g]) - @result{} [a b c d e f g] -(fillarray a 0) - @result{} [0 0 0 0 0 0 0] -a - @result{} [0 0 0 0 0 0 0] -@end group - -@group -(setq s "When in the course") - @result{} "When in the course" -(fillarray s ?-) - @result{} "------------------" -@end group - -@group -(setq bv #*1101) - @result{} #*1101 -(fillarray bv 0) - @result{} #*0000 -@end group -@end example - -If @var{array} is a string and @var{object} is not a character, a -@code{wrong-type-argument} error results. -@end defun - The general sequence functions @code{copy-sequence} and @code{length} are often useful for objects known to be arrays. @xref{Sequence Functions}.
--- a/man/lispref/specifiers.texi Tue Feb 22 22:56:02 2011 +0100 +++ b/man/lispref/specifiers.texi Thu Mar 17 23:42:59 2011 +0100 @@ -875,7 +875,7 @@ @code{add-spec-list-to-specifier}. @end defun -@defspec let-specifier specifier-list &rest body +@deffn {Special Operator} let-specifier specifier-list &rest body This macro temporarily adds specifications to specifiers, evaluates forms in @var{body} and restores the specifiers to their previous states. The specifiers and their temporary specifications are @@ -912,7 +912,7 @@ (let-specifier ((modeline-shadow-thickness 0 (selected-window))) (sit-for 1)) @end example -@end defspec +@end deffn @defun set-specifier specifier value &optional locale tag-set how-to-add This function adds some specifications to @var{specifier}. @var{value}
--- a/man/lispref/variables.texi Tue Feb 22 22:56:02 2011 +0100 +++ b/man/lispref/variables.texi Thu Mar 17 23:42:59 2011 +0100 @@ -168,7 +168,7 @@ The special operators @code{let} and @code{let*} exist to create local bindings. -@defspec let (bindings@dots{}) forms@dots{} +@deffn {Special Operator} let (bindings@dots{}) forms@dots{} This special operator binds variables according to @var{bindings} and then evaluates all of the @var{forms} in textual order. The @code{let}-form returns the value of the last form in @var{forms}. @@ -196,9 +196,9 @@ @result{} (1 2) @end group @end example -@end defspec +@end deffn -@defspec let* (bindings@dots{}) forms@dots{} +@deffn {Special Operator} let* (bindings@dots{}) forms@dots{} This special operator is like @code{let}, but it binds each variable right after computing its local value, before computing the local value for the next variable. Therefore, an expression in @var{bindings} can @@ -218,7 +218,7 @@ @result{} (1 1) @end group @end example -@end defspec +@end deffn Here is a complete list of the other facilities that create local bindings: @@ -403,7 +403,7 @@ files, and override the default values given in the definitions. For this reason, user options must be defined with @code{defvar}. -@defspec defvar symbol [value [doc-string]] +@deffn {Special Operator} defvar symbol [value [doc-string]] This special operator defines @var{symbol} as a value and initializes it. The definition informs a person reading your code that @var{symbol} is used as a variable that programs are likely to set or change. It is @@ -491,9 +491,9 @@ The @code{defvar} form returns @var{symbol}, but it is normally used at top level in a file where its value does not matter. -@end defspec +@end deffn -@defspec defconst symbol [value [doc-string]] +@deffn {Special Operator} defconst symbol [value [doc-string]] This special operator defines @var{symbol} as a value and initializes it. It informs a person reading your code that @var{symbol} has a global value, established here, that will not normally be changed or locally @@ -530,7 +530,7 @@ @result{} 3 @end group @end example -@end defspec +@end deffn @defun user-variable-p variable @cindex user option @@ -615,7 +615,7 @@ form @code{setq}. When you need to compute the choice of variable at run time, use the function @code{set}. -@defspec setq [symbol form]@dots{} +@deffn {Special Operator} setq [symbol form]@dots{} This special operator is the most common method of changing a variable's value. Each @var{symbol} is given a new value, which is the result of evaluating the corresponding @var{form}. The most-local existing @@ -655,7 +655,7 @@ @result{} 11 @end group @end example -@end defspec +@end deffn @defun set symbol value This function sets @var{symbol}'s value to @var{value}, then returns @@ -1253,7 +1253,7 @@ @code{symbol-value}. @end defun -@defspec setq-default symbol value +@deffn {Special Operator} setq-default symbol value This sets the default value of @var{symbol} to @var{value}. It does not evaluate @var{symbol}, but does evaluate @var{value}. The value of the @code{setq-default} form is @var{value}. @@ -1314,7 +1314,7 @@ @result{} another-default @end group @end example -@end defspec +@end deffn @defun set-default symbol value This function is like @code{setq-default}, except that @var{symbol} is
--- a/man/lispref/windows.texi Tue Feb 22 22:56:02 2011 +0100 +++ b/man/lispref/windows.texi Thu Mar 17 23:42:59 2011 +0100 @@ -442,12 +442,12 @@ @end example @end defun -@defspec save-selected-window forms@dots{} +@deffn {Special Operator} save-selected-window forms@dots{} This macro records the selected window, executes @var{forms} in sequence, then restores the earlier selected window. It does not save or restore anything about the sizes, arrangement or contents of windows; therefore, if the @var{forms} change them, the changes are permanent. -@end defspec +@end deffn @cindex finding windows The following functions choose one of the windows on the screen, @@ -1969,7 +1969,7 @@ @end example @end defun -@defspec save-window-excursion forms@dots{} +@deffn {Special Operator} save-window-excursion forms@dots{} This macro records the window configuration, executes @var{forms} in sequence, then restores the earlier window configuration. The window configuration includes the value of point and the portion of the buffer @@ -2005,7 +2005,7 @@ ;; @r{The frame is now split again.} @end group @end example -@end defspec +@end deffn @defun window-configuration-p object This function returns @code{t} if @var{object} is a window configuration.
--- a/src/ChangeLog Tue Feb 22 22:56:02 2011 +0100 +++ b/src/ChangeLog Thu Mar 17 23:42:59 2011 +0100 @@ -1,3 +1,57 @@ +2011-03-15 Aidan Kehoe <kehoea@parhasard.net> + + * config.h.in (SUPPORT_CONFOUNDING_FUNCTIONS): New #define, + equivalent NEED_TO_HANDLE_21_4_CODE by default, describing whether + this XEmacs should support the old-eq, old-equal and related + functions and byte codes. + * bytecode.c (UNUSED): + Only interpret old-eq, old-equal, old-memq if + SUPPORT_CONFOUNDING_FUNCTIONS is defined. + * data.c: + Move Fold_eq to fns.c with the rest of the Fold_* functions. + * fns.c: + * fns.c (Fmemq): + * fns.c (memq_no_quit): + * fns.c (assoc_no_quit): + * fns.c (Frassq): + * fns.c (Fequal): + * fns.c (Fold_equal): + * fns.c (syms_of_fns): + Group old-eq, old-equal, old-memq etc together, surround them with + #ifdef SUPPORT_CONFOUNDING_FUNCTIONS. + +2011-03-14 Aidan Kehoe <kehoea@parhasard.net> + + * glyphs-eimage.c (png_instantiate): + Update the PNG handling code to work with versions of the library + where the png_info structure is no longer visible. Thank you for + the report, Robert Delius Royar. + +2011-03-12 Aidan Kehoe <kehoea@parhasard.net> + + * event-stream.c (Fdispatch_event): + As documented, allow pre-command-hook to usefully modify + this-command even when this-command is nil (that is, we would + normally throw an undefined-keystroke-sequence error). Don't throw + that error if this-command was modified, instead try to execute + the new value. + Allow pre-command-hook to modify last-command-event in this + specific context. Don't document this, for the moment. + +2011-03-11 Aidan Kehoe <kehoea@parhasard.net> + + * bytecode.c (optimize_byte_code): + Only transform assignments to keywords to Bdiscard if + NEED_TO_HANDLE_21_4_CODE is turned on. Cf. similar code in + reject_constant_symbols(). + +2011-02-24 Aidan Kehoe <kehoea@parhasard.net> + + * fns.c (Fsubstring_no_properties): + Sigh, get_string_range_char checks the type of its START and END + arguments, but doesn't check the type of its STRING + argument. Thank you Raymond Toy! + 2011-02-19 Aidan Kehoe <kehoea@parhasard.net> * fns.c (Fset_exclusive_or):
--- a/src/bytecode.c Tue Feb 22 22:56:02 2011 +0100 +++ b/src/bytecode.c Thu Mar 17 23:42:59 2011 +0100 @@ -1690,6 +1690,8 @@ break; } +#ifdef SUPPORT_CONFOUNDING_FUNCTIONS + case Bold_eq: { Lisp_Object arg = POP; @@ -1725,6 +1727,8 @@ break; } +#endif + case Bbind_multiple_value_limits: { Lisp_Object upper = POP, first = TOP, speccount; @@ -1959,11 +1963,14 @@ wtaerror ("attempt to set non-symbol", val); if (EQ (val, Qnil) || EQ (val, Qt)) signal_error (Qsetting_constant, 0, val); +#ifdef NEED_TO_HANDLE_21_4_CODE /* Ignore assignments to keywords by converting to Bdiscard. - For backward compatibility only - we'd like to make this an error. */ + For backward compatibility only - we'd like to make this an + error. */ if (SYMBOL_IS_KEYWORD (val)) REWRITE_OPCODE (Bdiscard); else +#endif WRITE_NARGS (Bvarset); break;
--- a/src/config.h.in Tue Feb 22 22:56:02 2011 +0100 +++ b/src/config.h.in Thu Mar 17 23:42:59 2011 +0100 @@ -1181,4 +1181,6 @@ /* Do we need to be able to run code compiled by and written for 21.4? */ #define NEED_TO_HANDLE_21_4_CODE 1 +#define SUPPORT_CONFOUNDING_FUNCTIONS NEED_TO_HANDLE_21_4_CODE + #endif /* _SRC_CONFIG_H_ */
--- a/src/data.c Tue Feb 22 22:56:02 2011 +0100 +++ b/src/data.c Thu Mar 17 23:42:59 2011 +0100 @@ -181,24 +181,6 @@ return EQ_WITH_EBOLA_NOTICE (object1, object2) ? Qt : Qnil; } -DEFUN ("old-eq", Fold_eq, 2, 2, 0, /* -Return t if the two args are (in most cases) the same Lisp object. - -Special kludge: A character is considered `old-eq' to its equivalent integer -even though they are not the same object and are in fact of different -types. This is ABSOLUTELY AND UTTERLY HORRENDOUS but is necessary to -preserve byte-code compatibility with v19. This kludge is known as the -\"char-int confoundance disease\" and appears in a number of other -functions with `old-foo' equivalents. - -Do not use this function! -*/ - (object1, object2)) -{ - /* #### blasphemy */ - return HACKEQ_UNSAFE (object1, object2) ? Qt : Qnil; -} - DEFUN ("null", Fnull, 1, 1, 0, /* Return t if OBJECT is nil. */ @@ -3566,7 +3548,6 @@ DEFSUBR (Fdiv); #endif DEFSUBR (Feq); - DEFSUBR (Fold_eq); DEFSUBR (Fnull); Ffset (intern ("not"), intern ("null")); DEFSUBR (Flistp);
--- a/src/event-stream.c Tue Feb 22 22:56:02 2011 +0100 +++ b/src/event-stream.c Thu Mar 17 23:42:59 2011 +0100 @@ -4443,6 +4443,7 @@ { Lisp_Object leaf = lookup_command_event (command_builder, event, 1); + lookedup: if (KEYMAPP (leaf)) /* Incomplete key sequence */ break; @@ -4522,6 +4523,22 @@ GCPRO1 (keys); pre_command_hook (); UNGCPRO; + + if (!NILP (Vthis_command)) + { + /* Allow pre-command-hook to change the command to + something more useful, and avoid barfing. */ + leaf = Vthis_command; + if (!EQ (command_builder->most_current_event, + Vlast_command_event)) + { + reset_current_events (command_builder); + command_builder_append_event (command_builder, + Vlast_command_event); + } + goto lookedup; + } + /* The post-command-hook doesn't run. */ Fsignal (Qundefined_keystroke_sequence, list1 (keys)); }
--- a/src/fns.c Tue Feb 22 22:56:02 2011 +0100 +++ b/src/fns.c Thu Mar 17 23:42:59 2011 +0100 @@ -70,7 +70,6 @@ extern Fixnum max_lisp_eval_depth; extern int lisp_eval_depth; -static int internal_old_equal (Lisp_Object, Lisp_Object, int); Lisp_Object safe_copy_tree (Lisp_Object arg, Lisp_Object vecp, int depth); static DOESNT_RETURN @@ -2093,6 +2092,7 @@ Bytecount bstart, blen; Lisp_Object val; + CHECK_STRING (string); get_string_range_char (string, start, end, &ccstart, &ccend, GB_HISTORICAL_STRING_BEHAVIOR); bstart = string_index_char_to_byte (string, ccstart); @@ -2578,22 +2578,6 @@ return Qnil; } -DEFUN ("old-member", Fold_member, 2, 2, 0, /* -Return non-nil if ELT is an element of LIST. Comparison done with `old-equal'. -The value is actually the tail of LIST whose car is ELT. -This function is provided only for byte-code compatibility with v19. -Do not use it. -*/ - (elt, list)) -{ - EXTERNAL_LIST_LOOP_3 (list_elt, list, tail) - { - if (internal_old_equal (elt, list_elt, 0)) - return tail; - } - return Qnil; -} - DEFUN ("memq", Fmemq, 2, 2, 0, /* Return non-nil if ELT is an element of LIST. Comparison done with `eq'. The value is actually the tail of LIST whose car is ELT. @@ -2608,22 +2592,6 @@ return Qnil; } -DEFUN ("old-memq", Fold_memq, 2, 2, 0, /* -Return non-nil if ELT is an element of LIST. Comparison done with `old-eq'. -The value is actually the tail of LIST whose car is ELT. -This function is provided only for byte-code compatibility with v19. -Do not use it. -*/ - (elt, list)) -{ - EXTERNAL_LIST_LOOP_3 (list_elt, list, tail) - { - if (HACKEQ_UNSAFE (elt, list_elt)) - return tail; - } - return Qnil; -} - Lisp_Object memq_no_quit (Lisp_Object elt, Lisp_Object list) { @@ -2819,21 +2787,6 @@ return Qnil; } -DEFUN ("old-assoc", Fold_assoc, 2, 2, 0, /* -Return non-nil if KEY is `old-equal' to the car of an element of ALIST. -The value is actually the element of ALIST whose car equals KEY. -*/ - (key, alist)) -{ - /* This function can GC. */ - EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) - { - if (internal_old_equal (key, elt_car, 0)) - return elt; - } - return Qnil; -} - Lisp_Object assoc_no_quit (Lisp_Object key, Lisp_Object alist) { @@ -2857,23 +2810,6 @@ return Qnil; } -DEFUN ("old-assq", Fold_assq, 2, 2, 0, /* -Return non-nil if KEY is `old-eq' to the car of an element of ALIST. -The value is actually the element of ALIST whose car is KEY. -Elements of ALIST that are not conses are ignored. -This function is provided only for byte-code compatibility with v19. -Do not use it. -*/ - (key, alist)) -{ - EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) - { - if (HACKEQ_UNSAFE (key, elt_car)) - return elt; - } - return Qnil; -} - /* Like Fassq but never report an error and do not allow quits. Use only on lists known never to be circular. */ @@ -2957,20 +2893,6 @@ return Qnil; } -DEFUN ("old-rassoc", Fold_rassoc, 2, 2, 0, /* -Return non-nil if VALUE is `old-equal' to the cdr of an element of ALIST. -The value is actually the element of ALIST whose cdr equals VALUE. -*/ - (value, alist)) -{ - EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) - { - if (internal_old_equal (value, elt_cdr, 0)) - return elt; - } - return Qnil; -} - DEFUN ("rassq", Frassq, 2, 2, 0, /* Return non-nil if VALUE is `eq' to the cdr of an element of ALIST. The value is actually the element of ALIST whose cdr is VALUE. @@ -3275,34 +3197,6 @@ return object; } -DEFUN ("old-delete", Fold_delete, 2, 2, 0, /* -Delete by side effect any occurrences of ELT as a member of LIST. -The modified LIST is returned. Comparison is done with `old-equal'. -If the first member of LIST is ELT, there is no way to remove it by side -effect; therefore, write `(setq foo (old-delete element foo))' to be sure -of changing the value of `foo'. -*/ - (elt, list)) -{ - EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, - (internal_old_equal (elt, list_elt, 0))); - return list; -} - -DEFUN ("old-delq", Fold_delq, 2, 2, 0, /* -Delete by side effect any occurrences of ELT as a member of LIST. -The modified LIST is returned. Comparison is done with `old-eq'. -If the first member of LIST is ELT, there is no way to remove it by side -effect; therefore, write `(setq foo (old-delq element foo))' to be sure of -changing the value of `foo'. -*/ - (elt, list)) -{ - EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, - (HACKEQ_UNSAFE (elt, list_elt))); - return list; -} - /* Like Fdelq, but caller must ensure that LIST is properly nil-terminated and ebola-free. */ @@ -6534,26 +6428,6 @@ return internal_equal (obj1, obj2, depth); } -/* Note that we may be calling sub-objects that will use - internal_equal() (instead of internal_old_equal()). Oh well. - We will get an Ebola note if there's any possibility of confusion, - but that seems unlikely. */ - -static int -internal_old_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) -{ - if (depth + lisp_eval_depth > max_lisp_eval_depth) - stack_overflow ("Stack overflow in equal", Qunbound); - QUIT; - if (HACKEQ_UNSAFE (obj1, obj2)) - return 1; - /* Note that (equal 20 20.0) should be nil */ - if (XTYPE (obj1) != XTYPE (obj2)) - return 0; - - return internal_equal (obj1, obj2, depth); -} - DEFUN ("equal", Fequal, 2, 2, 0, /* Return t if two Lisp objects have similar structure and contents. They must have the same data type. @@ -6597,6 +6471,134 @@ return internal_equalp (object1, object2, 0) ? Qt : Qnil; } +#ifdef SUPPORT_CONFOUNDING_FUNCTIONS + +/* Note that we may be calling sub-objects that will use + internal_equal() (instead of internal_old_equal()). Oh well. + We will get an Ebola note if there's any possibility of confusion, + but that seems unlikely. */ + +static int +internal_old_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) +{ + if (depth + lisp_eval_depth > max_lisp_eval_depth) + stack_overflow ("Stack overflow in equal", Qunbound); + QUIT; + if (HACKEQ_UNSAFE (obj1, obj2)) + return 1; + /* Note that (equal 20 20.0) should be nil */ + if (XTYPE (obj1) != XTYPE (obj2)) + return 0; + + return internal_equal (obj1, obj2, depth); +} + +DEFUN ("old-member", Fold_member, 2, 2, 0, /* +Return non-nil if ELT is an element of LIST. Comparison done with `old-equal'. +The value is actually the tail of LIST whose car is ELT. +This function is provided only for byte-code compatibility with v19. +Do not use it. +*/ + (elt, list)) +{ + EXTERNAL_LIST_LOOP_3 (list_elt, list, tail) + { + if (internal_old_equal (elt, list_elt, 0)) + return tail; + } + return Qnil; +} + +DEFUN ("old-memq", Fold_memq, 2, 2, 0, /* +Return non-nil if ELT is an element of LIST. Comparison done with `old-eq'. +The value is actually the tail of LIST whose car is ELT. +This function is provided only for byte-code compatibility with v19. +Do not use it. +*/ + (elt, list)) +{ + EXTERNAL_LIST_LOOP_3 (list_elt, list, tail) + { + if (HACKEQ_UNSAFE (elt, list_elt)) + return tail; + } + return Qnil; +} + +DEFUN ("old-assoc", Fold_assoc, 2, 2, 0, /* +Return non-nil if KEY is `old-equal' to the car of an element of ALIST. +The value is actually the element of ALIST whose car equals KEY. +*/ + (key, alist)) +{ + /* This function can GC. */ + EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) + { + if (internal_old_equal (key, elt_car, 0)) + return elt; + } + return Qnil; +} + +DEFUN ("old-assq", Fold_assq, 2, 2, 0, /* +Return non-nil if KEY is `old-eq' to the car of an element of ALIST. +The value is actually the element of ALIST whose car is KEY. +Elements of ALIST that are not conses are ignored. +This function is provided only for byte-code compatibility with v19. +Do not use it. +*/ + (key, alist)) +{ + EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) + { + if (HACKEQ_UNSAFE (key, elt_car)) + return elt; + } + return Qnil; +} + +DEFUN ("old-rassoc", Fold_rassoc, 2, 2, 0, /* +Return non-nil if VALUE is `old-equal' to the cdr of an element of ALIST. +The value is actually the element of ALIST whose cdr equals VALUE. +*/ + (value, alist)) +{ + EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) + { + if (internal_old_equal (value, elt_cdr, 0)) + return elt; + } + return Qnil; +} + +DEFUN ("old-delete", Fold_delete, 2, 2, 0, /* +Delete by side effect any occurrences of ELT as a member of LIST. +The modified LIST is returned. Comparison is done with `old-equal'. +If the first member of LIST is ELT, there is no way to remove it by side +effect; therefore, write `(setq foo (old-delete element foo))' to be sure +of changing the value of `foo'. +*/ + (elt, list)) +{ + EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, + (internal_old_equal (elt, list_elt, 0))); + return list; +} + +DEFUN ("old-delq", Fold_delq, 2, 2, 0, /* +Delete by side effect any occurrences of ELT as a member of LIST. +The modified LIST is returned. Comparison is done with `old-eq'. +If the first member of LIST is ELT, there is no way to remove it by side +effect; therefore, write `(setq foo (old-delq element foo))' to be sure of +changing the value of `foo'. +*/ + (elt, list)) +{ + EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, + (HACKEQ_UNSAFE (elt, list_elt))); + return list; +} + DEFUN ("old-equal", Fold_equal, 2, 2, 0, /* Return t if two Lisp objects have similar structure and contents. They must have the same data type. @@ -6611,6 +6613,26 @@ return internal_old_equal (object1, object2, 0) ? Qt : Qnil; } +DEFUN ("old-eq", Fold_eq, 2, 2, 0, /* +Return t if the two args are (in most cases) the same Lisp object. + +Special kludge: A character is considered `old-eq' to its equivalent integer +even though they are not the same object and are in fact of different +types. This is ABSOLUTELY AND UTTERLY HORRENDOUS but is necessary to +preserve byte-code compatibility with v19. This kludge is known as the +\"char-int confoundance disease\" and appears in a number of other +functions with `old-foo' equivalents. + +Do not use this function! +*/ + (object1, object2)) +{ + /* #### blasphemy */ + return HACKEQ_UNSAFE (object1, object2) ? Qt : Qnil; +} + +#endif + static Lisp_Object replace_string_range_1 (Lisp_Object dest, Lisp_Object start, @@ -11795,25 +11817,17 @@ DEFSUBR (Fbutlast); DEFSUBR (Fnbutlast); DEFSUBR (Fmember); - DEFSUBR (Fold_member); DEFSUBR (Fmemq); - DEFSUBR (Fold_memq); DEFSUBR (FmemberX); DEFSUBR (Fadjoin); DEFSUBR (Fassoc); - DEFSUBR (Fold_assoc); DEFSUBR (Fassq); - DEFSUBR (Fold_assq); DEFSUBR (Frassoc); - DEFSUBR (Fold_rassoc); DEFSUBR (Frassq); - DEFSUBR (Fold_rassq); DEFSUBR (Fposition); DEFSUBR (Ffind); - DEFSUBR (Fold_delete); - DEFSUBR (Fold_delq); DEFSUBR (FdeleteX); DEFSUBR (FremoveX); DEFSUBR (Fremassoc); @@ -11850,8 +11864,20 @@ DEFSUBR (Fobject_setplist); DEFSUBR (Fequal); DEFSUBR (Fequalp); + DEFSUBR (Ffill); + +#ifdef SUPPORT_CONFOUNDING_FUNCTIONS + DEFSUBR (Fold_member); + DEFSUBR (Fold_memq); + DEFSUBR (Fold_assoc); + DEFSUBR (Fold_assq); + DEFSUBR (Fold_rassoc); + DEFSUBR (Fold_rassq); + DEFSUBR (Fold_delete); + DEFSUBR (Fold_delq); DEFSUBR (Fold_equal); - DEFSUBR (Ffill); + DEFSUBR (Fold_eq); +#endif DEFSUBR (FassocX); DEFSUBR (FrassocX);
--- a/src/glyphs-eimage.c Tue Feb 22 22:56:02 2011 +0100 +++ b/src/glyphs-eimage.c Thu Mar 17 23:42:59 2011 +0100 @@ -980,8 +980,8 @@ int y, padding; Binbyte **row_pointers; UINT_64_BIT pixels_sq; - height = info_ptr->height; - width = info_ptr->width; + height = png_get_image_height (png_ptr, info_ptr); + width = png_get_image_width (png_ptr, info_ptr); pixels_sq = (UINT_64_BIT) width * (UINT_64_BIT) height; if (pixels_sq > ((size_t) -1) / 3) signal_image_error ("PNG image too large to instantiate", instantiator); @@ -1042,30 +1042,37 @@ /* Now that we're using EImage, ask for 8bit RGB triples for any type of image*/ - /* convert palette images to RGB */ - if (info_ptr->color_type == PNG_COLOR_TYPE_PALETTE) - png_set_palette_to_rgb (png_ptr); - /* convert grayscale images to RGB */ - else if (info_ptr->color_type == PNG_COLOR_TYPE_GRAY || - info_ptr->color_type == PNG_COLOR_TYPE_GRAY_ALPHA) - png_set_gray_to_rgb (png_ptr); - /* pad images with depth < 8 bits */ - else if (info_ptr->bit_depth < 8) + switch (png_get_color_type (png_ptr, info_ptr)) { - if (info_ptr->color_type == PNG_COLOR_TYPE_GRAY) - png_set_expand (png_ptr); - else - png_set_packing (png_ptr); + case PNG_COLOR_TYPE_PALETTE: + /* convert palette images to RGB */ + png_set_palette_to_rgb (png_ptr); + break; + + case PNG_COLOR_TYPE_GRAY: + case PNG_COLOR_TYPE_GRAY_ALPHA: + /* convert grayscale images to RGB */ + png_set_gray_to_rgb (png_ptr); + break; + + default: + /* pad images with depth < 8 bits */ + if (png_get_bit_depth (png_ptr, info_ptr) < 8) + { + png_set_packing (png_ptr); + } + break; } + /* strip 16-bit depth files down to 8 bits */ - if (info_ptr->bit_depth == 16) + if (png_get_bit_depth (png_ptr, info_ptr) == 16) png_set_strip_16 (png_ptr); /* strip alpha channel #### shouldn't we handle this? first call png_read_update_info in case above transformations have generated an alpha channel */ png_read_update_info(png_ptr, info_ptr); - if (info_ptr->color_type & PNG_COLOR_MASK_ALPHA) + if (png_get_color_type (png_ptr, info_ptr) & PNG_COLOR_MASK_ALPHA) png_set_strip_alpha (png_ptr); png_read_image (png_ptr, row_pointers); @@ -1075,23 +1082,25 @@ * into the glyph code, where you can get to it from lisp * anyway. - WMP */ { - int i; + int ii, num_text = 0; + png_textp text_ptr = NULL; DECLARE_EISTRING (key); DECLARE_EISTRING (text); - for (i = 0 ; i < info_ptr->num_text ; i++) - { - /* How paranoid do I have to be about no trailing NULLs, and - using (int)info_ptr->text[i].text_length, and strncpy and a temp - string somewhere? */ - eireset(key); - eireset(text); - eicpy_ext(key, info_ptr->text[i].key, Qbinary); - eicpy_ext(text, info_ptr->text[i].text, Qbinary); + if (png_get_text (png_ptr, info_ptr, &text_ptr, &num_text) > 0) + { + for (ii = 0 ; ii < num_text; ii++) + { + eireset (key); + eireset (text); - warn_when_safe (Qpng, Qinfo, "%s - %s", - eidata(key), eidata(text)); - } + eicpy_ext (key, text_ptr[ii].key, Qbinary); + eicpy_ext (text, text_ptr[ii].text, Qbinary); + + warn_when_safe (Qpng, Qinfo, "%s - %s", eidata (key), + eidata (text)); + } + } } xfree (row_pointers);
--- a/tests/ChangeLog Tue Feb 22 22:56:02 2011 +0100 +++ b/tests/ChangeLog Thu Mar 17 23:42:59 2011 +0100 @@ -1,3 +1,31 @@ +2011-03-17 Aidan Kehoe <kehoea@parhasard.net> + + * automated/lisp-tests.el: + Only test the various old-* function if old-eq is bound and a + subr. + +2011-03-11 Aidan Kehoe <kehoea@parhasard.net> + + * automated/byte-compiler-tests.el: + (defconst :foo 1) now gives a warning when byte-compiled, check + for that. + (setq :foo 1) now errors with interpreted code, but succeeds with + byte-compiled code; check for the former, wrap a + Known-Bug-Expect-Failure around a check for the error in the + latter case, we can't yet remove this behaviour while we're using + packages compiled by 21.4. + * automated/lisp-tests.el (wrong-type-argument): + Integer zero is a valid argument to #'substring-no-properties, use + Assert not Check-Error for it. Check some other aspects of the + functionality of #'substring-no-properties in passing. + +2011-02-24 Aidan Kehoe <kehoea@parhasard.net> + + * automated/lisp-tests.el (substring-no-properties): + Make sure this function checks its arguments' types, the absence + of which was revealed by Raymond Toy's bug report of + http://mid.gmane.org/4D65D413.5050103@gmail.com . + 2011-02-10 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el:
--- a/tests/automated/byte-compiler-tests.el Tue Feb 22 22:56:02 2011 +0100 +++ b/tests/automated/byte-compiler-tests.el Thu Mar 17 23:42:59 2011 +0100 @@ -43,7 +43,7 @@ (check-byte-compiler-message "Attempt to set non-symbol" (setq 1 1)) (check-byte-compiler-message "Attempt to set constant symbol" (setq t 1)) (check-byte-compiler-message "Attempt to set constant symbol" (setq nil 1)) -(check-byte-compiler-message "^$" (defconst :foo 1)) +(check-byte-compiler-message "Attempt to set constant symbol" (defconst :foo 1)) (check-byte-compiler-message "Attempt to let-bind non-symbol" (let ((1 'x)) 1)) (check-byte-compiler-message "Attempt to let-bind constant symbol" (let ((t 'x)) (foo))) @@ -58,12 +58,16 @@ (check-byte-compiler-message "reference to free variable" (car free-variable)) (check-byte-compiler-message "called with 2 args, but requires 1" (car 'x 'y)) -(check-byte-compiler-message "^$" (setq :foo 1)) (let ((fun '(lambda () (setq :foo 1)))) (fset 'test-byte-compiler-fun fun)) (Check-Error setting-constant (test-byte-compiler-fun)) -(byte-compile 'test-byte-compiler-fun) -(Check-Error setting-constant (test-byte-compiler-fun)) +(Check-Message "Attempt to set constant symbol" + (byte-compile 'test-byte-compiler-fun)) + +;; Once NEED_TO_HANDLE_21_4_CODE is no longer defined in C, this will error +;; correctly. It's disabled because the packages are compiled by 21.4. +(Known-Bug-Expect-Failure + (Check-Error setting-constant (test-byte-compiler-fun))) (eval-when-compile (defvar setq-test-foo nil) (defvar setq-test-bar nil)) (progn
--- a/tests/automated/lisp-tests.el Tue Feb 22 22:56:02 2011 +0100 +++ b/tests/automated/lisp-tests.el Thu Mar 17 23:42:59 2011 +0100 @@ -794,18 +794,18 @@ (Check-Error (malformed-list wrong-type-argument) (,fun nil 1)) ,@(loop for n in '(1 2 2000) collect `(Check-Error circular-list (,fun 1 (make-circular-list ,n)))))) - (test-funs (&rest funs) `(progn ,@(loop for fun in funs collect `(test-fun ,fun))))) - + (test-funs (&rest funs) `(progn ,@(loop for fun in funs collect `(test-fun ,fun)))) + (test-old-funs (&rest funs) + `(when (and (fboundp 'old-eq) (subrp (symbol-function 'old-eq))) + ,@(loop for fun in funs collect `(test-fun ,fun))))) (test-funs member* member memq assoc* assoc assq rassoc* rassoc rassq delete* delete delq remove* remove remq - old-member old-memq - old-assoc old-assq - old-rassoc old-rassq - old-delete old-delq - remassoc remassq remrassoc remrassq)) + remassoc remassq remrassoc remrassq) + (test-old-funs old-member old-memq old-assoc old-assq old-rassoc old-rassq + old-delete old-delq)) (let ((x '((1 . 2) 3 (4 . 5)))) (Assert (eq (assoc 1 x) (car x))) @@ -889,19 +889,15 @@ (Assert (let* ((x (a)) (y (remassq 6 x))) (and (eq x y) (equal y (a))))) (Assert (let* ((x (a)) (y (remrassoc 6 x))) (and (eq x y) (equal y (a))))) (Assert (let* ((x (a)) (y (remrassq 6 x))) (and (eq x y) (equal y (a))))) - (Assert (let* ((x (a)) (y (delete 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5)))))) (Assert (let* ((x (a)) (y (delq 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5)))))) - (Assert (let* ((x (a)) (y (old-delete 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5)))))) - (Assert (let* ((x (a)) (y (old-delq 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5)))))) - (Assert (let* ((x (a)) (y (delete '(1 . 2) x))) (and (not (eq x y)) (equal y '(3 (4 . 5)))))) (Assert (let* ((x (a)) (y (delq '(1 . 2) x))) (and (eq x y) (equal y (a))))) - (Assert (let* ((x (a)) (y (old-delete '(1 . 2) x))) (and (not (eq x y)) (equal y '(3 (4 . 5)))))) - (Assert (let* ((x (a)) (y (old-delq '(1 . 2) x))) (and (eq x y) (equal y (a))))) - ) - - + (when (and (fboundp 'old-eq) (subrp (symbol-function 'old-eq))) + (Assert (let* ((x (a)) (y (old-delete '(1 . 2) x))) (and (not (eq x y)) (equal y '(3 (4 . 5)))))) + (Assert (let* ((x (a)) (y (old-delq '(1 . 2) x))) (and (eq x y) (equal y (a))))) + (Assert (let* ((x (a)) (y (old-delete 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5)))))) + (Assert (let* ((x (a)) (y (old-delq 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5)))))))) (flet ((a () (list '("1" . "2") "3" '("4" . "5")))) (Assert (let* ((x (a)) (y (remassoc "1" x))) (and (not (eq x y)) (equal y '("3" ("4" . "5")))))) @@ -1337,6 +1333,18 @@ (Check-Error args-out-of-range (subseq [1 2 3] -42)) (Check-Error args-out-of-range (subseq [1 2 3] 0 42)) +(let ((string "hi there")) + (Assert (equal (substring-no-properties "123" 0) "123")) + (Assert (equal (substring-no-properties "1234" -3 -1) "23")) + (Assert (equal (substring-no-properties "hi there" 0) "hi there")) + (put-text-property 0 (length string) 'foo 'bar string) + (Assert (eq 'bar (get-text-property 0 'foo string))) + (Assert (not + (get-text-property 0 'foo (substring-no-properties "hi there" 0)))) + (Check-Error wrong-type-argument (substring-no-properties nil 4)) + (Check-Error wrong-type-argument (substring-no-properties "hi there" pi)) + (Check-Error wrong-type-argument (substring-no-properties "hi there" 0.0))) + ;;----------------------------------------------------- ;; Time-related tests ;;-----------------------------------------------------