Now on revision 110862. ------------------------------------------------------------ revno: 110862 fixes bug: http://debbugs.gnu.org/12796 committer: Leo Liu branch nick: trunk timestamp: Sat 2012-11-10 09:28:22 +0800 message: * lisp/ido.el (ido-set-matches-1): Improve flex matching performance by removing backtracking in the regexp (suggested by Stefan). diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-11-09 22:20:47 +0000 +++ lisp/ChangeLog 2012-11-10 01:28:22 +0000 @@ -1,3 +1,8 @@ +2012-11-10 Leo Liu + + * ido.el (ido-set-matches-1): Improve flex matching performance by + removing backtracking in the regexp (suggested by Stefan). (Bug#12796) + 2012-11-09 Stefan Monnier * emacs-lisp/advice.el (ad-set-advice-info): Set defalias-fset-function. === modified file 'lisp/ido.el' --- lisp/ido.el 2012-10-05 07:38:05 +0000 +++ lisp/ido.el 2012-11-10 01:28:22 +0000 @@ -3764,7 +3764,11 @@ ido-enable-flex-matching (> (length ido-text) 1) (not ido-enable-regexp)) - (setq re (mapconcat #'regexp-quote (split-string ido-text "") ".*")) + (setq re (concat (regexp-quote (string (aref ido-text 0))) + (mapconcat (lambda (c) + (concat "[^" (string c) "]*" + (regexp-quote (string c)))) + (substring ido-text 1) ""))) (if ido-enable-prefix (setq re (concat "\\`" re))) (mapc ------------------------------------------------------------ revno: 110861 committer: Stefan Monnier branch nick: trunk timestamp: Fri 2012-11-09 17:20:47 -0500 message: Provide new `defalias-fset-function' symbol property. * src/lisp.h (AUTOLOADP): New macro. * src/eval.c (Fautoload): Don't attach to loadhist, call Fdefalias instead. * src/data.c (Ffset): Remove special ad-advice-info handling. (Fdefalias): Handle autoload definitions and new Qdefalias_fset_function. (Fsubr_arity): CSE. (Finteractive_form): Simplify. (Fquo): Don't insist on having at least 2 arguments. (Qdefalias_fset_function): New var. * lisp/emacs-lisp/advice.el (ad-set-advice-info): Set defalias-fset-function. (ad--defalias-fset): New function. (ad-safe-fset): Remove. (ad-make-freeze-definition): Use cl-letf*. diff: === modified file 'etc/NEWS' --- etc/NEWS 2012-11-09 20:45:10 +0000 +++ etc/NEWS 2012-11-09 22:20:47 +0000 @@ -38,6 +38,9 @@ ** Docstrings can be made dynamic by adding a `dynamic-docstring-function' text-property on the first char. +** The `defalias-fset-function' property lets you catch calls to defalias +and redirect them to your own function instead of `fset'. + * Changes in Emacs 24.4 on non-free operating systems === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-11-09 20:45:10 +0000 +++ lisp/ChangeLog 2012-11-09 22:20:47 +0000 @@ -1,5 +1,12 @@ 2012-11-09 Stefan Monnier + * emacs-lisp/advice.el (ad-set-advice-info): Set defalias-fset-function. + (ad--defalias-fset): New function. + (ad-safe-fset): Remove. + (ad-make-freeze-definition): Use cl-letf*. + +2012-11-09 Stefan Monnier + * subr.el (dolist): Don't bind VAR in RESULT. * emacs-lisp/advice.el: Miscellaneous cleanup. Use lexical-binding. === modified file 'lisp/emacs-lisp/advice.el' --- lisp/emacs-lisp/advice.el 2012-11-09 20:41:03 +0000 +++ lisp/emacs-lisp/advice.el 2012-11-09 22:20:47 +0000 @@ -1846,8 +1846,12 @@ (defmacro ad-get-advice-info-macro (function) `(get ,function 'ad-advice-info)) -(defmacro ad-set-advice-info (function advice-info) - `(put ,function 'ad-advice-info ,advice-info)) +(defsubst ad-set-advice-info (function advice-info) + (cond + (advice-info (put function 'defalias-fset-function #'ad--defalias-fset)) + ((get function 'defalias-fset-function) + (put function 'defalias-fset-function nil))) + (put function 'ad-advice-info advice-info)) (defmacro ad-copy-advice-info (function) `(copy-tree (get ,function 'ad-advice-info))) @@ -1954,18 +1958,10 @@ ;; @@ Dealing with automatic advice activation via `fset/defalias': ;; ================================================================ -;; Since Emacs 19.26 the built-in versions of `fset' and `defalias' -;; take care of automatic advice activation, hence, we don't have to -;; hack it anymore by advising `fset/defun/defmacro/byte-code/etc'. +;; Automatic activation happens when a function gets defined via `defalias', +;; which calls the `defalias-fset-function' (which we set to +;; `ad--defalias-fset') instead of `fset', if non-nil. -;; The functionality of the new `fset' is as follows: -;; -;; fset(sym,newdef) -;; assign NEWDEF to SYM -;; if (get SYM 'ad-advice-info) -;; ad-activate-internal(SYM, nil) -;; return (symbol-function SYM) -;; ;; Whether advised definitions created by automatic activations will be ;; compiled depends on the value of `ad-default-compilation-action'. @@ -1977,6 +1973,10 @@ ;; to `ad-activate' by using `ad-with-auto-activation-disabled' where ;; appropriate, especially in a safe version of `fset'. +(defun ad--defalias-fset (function definition) + (fset function definition) + (ad-activate-internal function nil)) + ;; For now define `ad-activate-internal' to the dummy definition: (defun ad-activate-internal (_function &optional _compile) "Automatic advice activation is disabled. `ad-start-advice' enables it." @@ -1994,12 +1994,6 @@ `(let ((ad-activate-on-top-level nil)) ,@body)) -(defun ad-safe-fset (symbol definition) - "A safe `fset' which will never call `ad-activate-internal' recursively." - (ad-with-auto-activation-disabled - (fset symbol definition))) - - ;; @@ Access functions for original definitions: ;; ============================================ ;; The advice-info of an advised function contains its `origname' which is @@ -2019,8 +2013,7 @@ (symbol-function origname)))) (defmacro ad-set-orig-definition (function definition) - `(ad-safe-fset - (ad-get-advice-info-field ,function 'origname) ,definition)) + `(fset (ad-get-advice-info-field ,function 'origname) ,definition)) (defmacro ad-clear-orig-definition (function) `(fmakunbound (ad-get-advice-info-field ,function 'origname))) @@ -3151,7 +3144,7 @@ (ad-set-advice-info function old-advice-info) ;; Don't `fset' function to nil if it was previously unbound: (if function-defined-p - (ad-safe-fset function old-definition) + (fset function old-definition) (fmakunbound function))))) @@ -3182,61 +3175,54 @@ (error "ad-make-freeze-definition: `%s' is not yet defined" function)) - (let* ((name (ad-advice-name advice)) - ;; With a unique origname we can have multiple freeze advices - ;; for the same function, each overloading the previous one: - (unique-origname - (intern (format "%s-%s-%s" (ad-make-origname function) class name))) - (orig-definition - ;; If FUNCTION is already advised, we'll use its current origdef - ;; as the original definition of the frozen advice: - (or (ad-get-orig-definition function) - (symbol-function function))) - (old-advice-info - (if (ad-is-advised function) - (ad-copy-advice-info function))) - (real-docstring-fn - (symbol-function 'ad-make-advised-definition-docstring)) - (real-origname-fn - (symbol-function 'ad-make-origname)) - (frozen-definition - (unwind-protect - (progn - ;; Make sure we construct a proper docstring: - (ad-safe-fset 'ad-make-advised-definition-docstring - 'ad-make-freeze-docstring) - ;; Make sure `unique-origname' is used as the origname: - (ad-safe-fset 'ad-make-origname (lambda (_x) unique-origname)) - ;; No we reset all current advice information to nil and - ;; generate an advised definition that's solely determined - ;; by ADVICE and the current origdef of FUNCTION: - (ad-set-advice-info function nil) - (ad-add-advice function advice class position) - ;; The following will provide proper real docstrings as - ;; well as a definition that will make the compiler happy: - (ad-set-orig-definition function orig-definition) - (ad-make-advised-definition function)) - ;; Restore the old advice state: - (ad-set-advice-info function old-advice-info) - ;; Restore functions: - (ad-safe-fset - 'ad-make-advised-definition-docstring real-docstring-fn) - (ad-safe-fset 'ad-make-origname real-origname-fn)))) + (cl-letf* + ((name (ad-advice-name advice)) + ;; With a unique origname we can have multiple freeze advices + ;; for the same function, each overloading the previous one: + (unique-origname + (intern (format "%s-%s-%s" (ad-make-origname function) class name))) + (orig-definition + ;; If FUNCTION is already advised, we'll use its current origdef + ;; as the original definition of the frozen advice: + (or (ad-get-orig-definition function) + (symbol-function function))) + (old-advice-info + (if (ad-is-advised function) + (ad-copy-advice-info function))) + ;; Make sure we construct a proper docstring: + ((symbol-function 'ad-make-advised-definition-docstring) + #'ad-make-freeze-docstring) + ;; Make sure `unique-origname' is used as the origname: + ((symbol-function 'ad-make-origname) (lambda (_x) unique-origname)) + (frozen-definition + (unwind-protect + (progn + ;; No we reset all current advice information to nil and + ;; generate an advised definition that's solely determined + ;; by ADVICE and the current origdef of FUNCTION: + (ad-set-advice-info function nil) + (ad-add-advice function advice class position) + ;; The following will provide proper real docstrings as + ;; well as a definition that will make the compiler happy: + (ad-set-orig-definition function orig-definition) + (ad-make-advised-definition function)) + ;; Restore the old advice state: + (ad-set-advice-info function old-advice-info)))) (if frozen-definition (let* ((macro-p (ad-macro-p frozen-definition)) (body (cdr (if macro-p (ad-lambdafy frozen-definition) - frozen-definition)))) + frozen-definition)))) `(progn - (if (not (fboundp ',unique-origname)) - (fset ',unique-origname - ;; avoid infinite recursion in case the function - ;; we want to freeze is already advised: - (or (ad-get-orig-definition ',function) - (symbol-function ',function)))) - (,(if macro-p 'defmacro 'defun) - ,function - ,@body)))))) + (if (not (fboundp ',unique-origname)) + (fset ',unique-origname + ;; avoid infinite recursion in case the function + ;; we want to freeze is already advised: + (or (ad-get-orig-definition ',function) + (symbol-function ',function)))) + (,(if macro-p 'defmacro 'defun) + ,function + ,@body)))))) ;; @@ Activation and definition handling: @@ -3269,7 +3255,7 @@ (let ((verified-cached-definition (if (ad-verify-cache-id function) (ad-get-cache-definition function)))) - (ad-safe-fset function + (fset function (or verified-cached-definition (ad-make-advised-definition function))) (if (ad-should-compile function compile) @@ -3311,7 +3297,7 @@ (error "ad-handle-definition (see its doc): `%s' %s" function "invalidly redefined") (if (eq ad-redefinition-action 'discard) - (ad-safe-fset function original-definition) + (fset function original-definition) (ad-set-orig-definition function current-definition) (if (eq ad-redefinition-action 'warn) (message "ad-handle-definition: `%s' got redefined" @@ -3386,7 +3372,7 @@ (if (not (ad-get-orig-definition function)) (error "ad-deactivate: `%s' has no original definition" function) - (ad-safe-fset function (ad-get-orig-definition function)) + (fset function (ad-get-orig-definition function)) (ad-set-advice-info-field function 'active nil) (eval (ad-make-hook-form function 'deactivation)) function))))) @@ -3424,7 +3410,7 @@ (completing-read "Recover advised function: " obarray nil t)))) (cond ((ad-is-advised function) (cond ((ad-get-orig-definition function) - (ad-safe-fset function (ad-get-orig-definition function)) + (fset function (ad-get-orig-definition function)) (ad-clear-orig-definition function))) (ad-set-advice-info function nil) (ad-pop-advised-function function)))) @@ -3658,8 +3644,7 @@ (setq index -1) (mapcar (lambda (function) (setq index (1+ index)) - `(ad-safe-fset - ',function + `(fset ',function (or (ad-get-orig-definition ',function) ,(car (nth index current-bindings))))) functions)) @@ -3670,8 +3655,7 @@ (setq index -1) (mapcar (lambda (function) (setq index (1+ index)) - `(ad-safe-fset - ',function + `(fset ',function ,(car (nth index current-bindings)))) functions)))))) @@ -3684,7 +3668,7 @@ (interactive) ;; Advising `ad-activate-internal' means death!! (ad-set-advice-info 'ad-activate-internal nil) - (ad-safe-fset 'ad-activate-internal 'ad-activate)) + (fset 'ad-activate-internal 'ad-activate)) (defun ad-stop-advice () "Stop the automatic advice handling magic. @@ -3692,7 +3676,7 @@ (interactive) ;; Advising `ad-activate-internal' means death!! (ad-set-advice-info 'ad-activate-internal nil) - (ad-safe-fset 'ad-activate-internal 'ad-activate-internal-off)) + (fset 'ad-activate-internal 'ad-activate-internal-off)) (defun ad-recover-normality () "Undo all advice related redefinitions and unadvises everything. @@ -3700,7 +3684,7 @@ (interactive) ;; Advising `ad-activate-internal' means death!! (ad-set-advice-info 'ad-activate-internal nil) - (ad-safe-fset 'ad-activate-internal 'ad-activate-internal-off) + (fset 'ad-activate-internal 'ad-activate-internal-off) (ad-recover-all) (ad-do-advised-functions (function) (message "Oops! Left over advised function %S" function) === modified file 'src/ChangeLog' --- src/ChangeLog 2012-11-09 19:47:28 +0000 +++ src/ChangeLog 2012-11-09 22:20:47 +0000 @@ -1,3 +1,14 @@ +2012-11-09 Stefan Monnier + + * lisp.h (AUTOLOADP): New macro. + * eval.c (Fautoload): Don't attach to loadhist, call Fdefalias instead. + * data.c (Ffset): Remove special ad-advice-info handling. + (Fdefalias): Handle autoload definitions and new Qdefalias_fset_function. + (Fsubr_arity): CSE. + (Finteractive_form): Simplify. + (Fquo): Don't insist on having at least 2 arguments. + (Qdefalias_fset_function): New var. + 2012-11-09 Jan Djärv * image.c (xpm_make_color_table_h): Change to hashtest_equal. @@ -26,7 +37,7 @@ 2012-11-09 Jan Djärv - * nsfont.m (ns_descriptor_to_entity): Qcondesed and Qexpanded has + * nsfont.m (ns_descriptor_to_entity): Qcondensed and Qexpanded has been removed, so remove them here also. 2012-11-09 Stefan Monnier === modified file 'src/data.c' --- src/data.c 2012-09-23 08:44:20 +0000 +++ src/data.c 2012-11-09 22:20:47 +0000 @@ -80,7 +80,7 @@ Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; static Lisp_Object Qdefun; -Lisp_Object Qinteractive_form; +Lisp_Object Qinteractive_form, Qdefalias_fset_function; static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct Lisp_Buffer_Local_Value *); @@ -444,7 +444,7 @@ } -/* Extract and set components of lists */ +/* Extract and set components of lists. */ DEFUN ("car", Fcar, Scar, 1, 1, 0, doc: /* Return the car of LIST. If arg is nil, return nil. @@ -608,27 +608,18 @@ (register Lisp_Object symbol, Lisp_Object definition) { register Lisp_Object function; - CHECK_SYMBOL (symbol); - if (NILP (symbol) || EQ (symbol, Qt)) - xsignal1 (Qsetting_constant, symbol); function = XSYMBOL (symbol)->function; if (!NILP (Vautoload_queue) && !EQ (function, Qunbound)) Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue); - if (CONSP (function) && EQ (XCAR (function), Qautoload)) + if (AUTOLOADP (function)) Fput (symbol, Qautoload, XCDR (function)); set_symbol_function (symbol, definition); - /* Handle automatic advice activation. */ - if (CONSP (XSYMBOL (symbol)->plist) - && !NILP (Fget (symbol, Qad_advice_info))) - { - call2 (Qad_activate_internal, symbol, Qnil); - definition = XSYMBOL (symbol)->function; - } + return definition; } @@ -642,15 +633,32 @@ (register Lisp_Object symbol, Lisp_Object definition, Lisp_Object docstring) { CHECK_SYMBOL (symbol); - if (CONSP (XSYMBOL (symbol)->function) - && EQ (XCAR (XSYMBOL (symbol)->function), Qautoload)) - LOADHIST_ATTACH (Fcons (Qt, symbol)); if (!NILP (Vpurify_flag) /* If `definition' is a keymap, immutable (and copying) is wrong. */ && !KEYMAPP (definition)) definition = Fpurecopy (definition); - definition = Ffset (symbol, definition); - LOADHIST_ATTACH (Fcons (Qdefun, symbol)); + + { + bool autoload = AUTOLOADP (definition); + if (NILP (Vpurify_flag) || !autoload) + { /* Only add autoload entries after dumping, because the ones before are + not useful and else we get loads of them from the loaddefs.el. */ + + if (AUTOLOADP (XSYMBOL (symbol)->function)) + /* Remember that the function was already an autoload. */ + LOADHIST_ATTACH (Fcons (Qt, symbol)); + LOADHIST_ATTACH (Fcons (autoload ? Qautoload : Qdefun, symbol)); + } + } + + { /* Handle automatic advice activation. */ + Lisp_Object hook = Fget (symbol, Qdefalias_fset_function); + if (!NILP (hook)) + call2 (hook, symbol, definition); + else + Ffset (symbol, definition); + } + if (!NILP (docstring)) Fput (symbol, Qfunction_documentation, docstring); /* We used to return `definition', but now that `defun' and `defmacro' expand @@ -680,12 +688,10 @@ CHECK_SUBR (subr); minargs = XSUBR (subr)->min_args; maxargs = XSUBR (subr)->max_args; - if (maxargs == MANY) - return Fcons (make_number (minargs), Qmany); - else if (maxargs == UNEVALLED) - return Fcons (make_number (minargs), Qunevalled); - else - return Fcons (make_number (minargs), make_number (maxargs)); + return Fcons (make_number (minargs), + maxargs == MANY ? Qmany + : maxargs == UNEVALLED ? Qunevalled + : make_number (maxargs)); } DEFUN ("subr-name", Fsubr_name, Ssubr_name, 1, 1, 0, @@ -711,7 +717,7 @@ return Qnil; /* Use an `interactive-form' property if present, analogous to the - function-documentation property. */ + function-documentation property. */ fun = cmd; while (SYMBOLP (fun)) { @@ -735,6 +741,8 @@ if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE) return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE)); } + else if (AUTOLOADP (fun)) + return Finteractive_form (Fautoload_do_load (fun, cmd, Qnil)); else if (CONSP (fun)) { Lisp_Object funcar = XCAR (fun); @@ -742,14 +750,6 @@ return Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun)))); else if (EQ (funcar, Qlambda)) return Fassq (Qinteractive, Fcdr (XCDR (fun))); - else if (EQ (funcar, Qautoload)) - { - struct gcpro gcpro1; - GCPRO1 (cmd); - Fautoload_do_load (fun, cmd, Qnil); - UNGCPRO; - return Finteractive_form (cmd); - } } return Qnil; } @@ -2695,10 +2695,10 @@ return arith_driver (Amult, nargs, args); } -DEFUN ("/", Fquo, Squo, 2, MANY, 0, +DEFUN ("/", Fquo, Squo, 1, MANY, 0, doc: /* Return first argument divided by all the remaining arguments. The arguments must be numbers or markers. -usage: (/ DIVIDEND DIVISOR &rest DIVISORS) */) +usage: (/ DIVIDEND &rest DIVISORS) */) (ptrdiff_t nargs, Lisp_Object *args) { ptrdiff_t argnum; @@ -3063,6 +3063,7 @@ DEFSYM (Qfont_object, "font-object"); DEFSYM (Qinteractive_form, "interactive-form"); + DEFSYM (Qdefalias_fset_function, "defalias-fset-function"); defsubr (&Sindirect_variable); defsubr (&Sinteractive_form); === modified file 'src/eval.c' --- src/eval.c 2012-10-11 20:08:38 +0000 +++ src/eval.c 2012-11-09 22:20:47 +0000 @@ -1876,26 +1876,19 @@ CHECK_STRING (file); /* If function is defined and not as an autoload, don't override. */ - if ((CONSP (XSYMBOL (function)->function) - && EQ (XCAR (XSYMBOL (function)->function), Qautoload))) - /* Remember that the function was already an autoload. */ - LOADHIST_ATTACH (Fcons (Qt, function)); - else if (!EQ (XSYMBOL (function)->function, Qunbound)) + if (!EQ (XSYMBOL (function)->function, Qunbound) + && !AUTOLOADP (XSYMBOL (function)->function)) return Qnil; - if (NILP (Vpurify_flag)) - /* Only add entries after dumping, because the ones before are - not useful and else we get loads of them from the loaddefs.el. */ - LOADHIST_ATTACH (Fcons (Qautoload, function)); - else if (EQ (docstring, make_number (0))) + if (!NILP (Vpurify_flag) && EQ (docstring, make_number (0))) /* `read1' in lread.c has found the docstring starting with "\ and assumed the docstring will be provided by Snarf-documentation, so it passed us 0 instead. But that leads to accidental sharing in purecopy's hash-consing, so we use a (hopefully) unique integer instead. */ - docstring = make_number (XUNTAG (function, Lisp_Symbol)); - return Ffset (function, - Fpurecopy (list5 (Qautoload, file, docstring, - interactive, type))); + docstring = make_number (XHASH (function)); + return Fdefalias (function, + list5 (Qautoload, file, docstring, interactive, type), + Qnil); } Lisp_Object === modified file 'src/lisp.h' --- src/lisp.h 2012-11-09 00:08:12 +0000 +++ src/lisp.h 2012-11-09 22:20:47 +0000 @@ -1694,6 +1694,8 @@ #define MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker) #define SAVE_VALUEP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value) +#define AUTOLOADP(x) (CONSP (x) && EQ (Qautoload, XCAR (x))) + #define INTFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Int) #define BOOLFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Bool) #define OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Obj) ------------------------------------------------------------ revno: 110860 committer: Stefan Monnier branch nick: trunk timestamp: Fri 2012-11-09 15:45:10 -0500 message: * lisp/subr.el (dolist): Don't bind VAR in RESULT. diff: === modified file 'etc/NEWS' --- etc/NEWS 2012-11-09 04:10:16 +0000 +++ etc/NEWS 2012-11-09 20:45:10 +0000 @@ -28,6 +28,11 @@ * Changes in Specialized Modes and Packages in Emacs 24.4 * New Modes and Packages in Emacs 24.4 * Incompatible Lisp Changes in Emacs 24.4 + +** `dolist' in lexical-binding mode does not bind VAR in RESULT any more. +VAR was bound to nil which was not tremendously useful and just lead to +spurious warnings about an unused var. + * Lisp changes in Emacs 24.4 ** Docstrings can be made dynamic by adding a `dynamic-docstring-function' === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-11-09 20:41:03 +0000 +++ lisp/ChangeLog 2012-11-09 20:45:10 +0000 @@ -1,5 +1,7 @@ 2012-11-09 Stefan Monnier + * subr.el (dolist): Don't bind VAR in RESULT. + * emacs-lisp/advice.el: Miscellaneous cleanup. Use lexical-binding. (fset, documentation): Don't save real def since we don't advise. (ad-do-advised-functions): Remove problematic `result-form'. === modified file 'lisp/subr.el' --- lisp/subr.el 2012-11-08 19:45:58 +0000 +++ lisp/subr.el 2012-11-09 20:45:10 +0000 @@ -222,9 +222,7 @@ (let ((,(car spec) (car ,temp))) ,@body (setq ,temp (cdr ,temp)))) - ,@(if (cdr (cdr spec)) - ;; FIXME: This let often leads to "unused var" warnings. - `((let ((,(car spec) nil)) ,@(cdr (cdr spec)))))) + ,@(cdr (cdr spec))) `(let ((,temp ,(nth 1 spec)) ,(car spec)) (while ,temp ------------------------------------------------------------ revno: 110859 committer: Stefan Monnier branch nick: trunk timestamp: Fri 2012-11-09 15:41:03 -0500 message: * lisp/emacs-lisp/advice.el: Miscellaneous cleanup. Use lexical-binding. (fset, documentation): Don't save real def since we don't advise. (ad-do-advised-functions): Remove problematic `result-form'. (ad-safe-fset): `ad-real-fset' => `fset'. (ad-read-advised-function): Don't assume that ad-do-advised-functions uses CL's dolist internally. (ad-arglist): Remove unused arg `name'. (ad-docstring, ad-make-advised-docstring): `ad-real-documentation' => `documentation'. (warning-suppress-types): Declare. (ad-set-arguments): Simple CSE. (ad-recover-normality): Sanity check. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-11-09 15:56:51 +0000 +++ lisp/ChangeLog 2012-11-09 20:41:03 +0000 @@ -1,5 +1,18 @@ 2012-11-09 Stefan Monnier + * emacs-lisp/advice.el: Miscellaneous cleanup. Use lexical-binding. + (fset, documentation): Don't save real def since we don't advise. + (ad-do-advised-functions): Remove problematic `result-form'. + (ad-safe-fset): `ad-real-fset' => `fset'. + (ad-read-advised-function): Don't assume that ad-do-advised-functions + uses CL's dolist internally. + (ad-arglist): Remove unused arg `name'. + (ad-docstring, ad-make-advised-docstring): + `ad-real-documentation' => `documentation'. + (warning-suppress-types): Declare. + (ad-set-arguments): Simple CSE. + (ad-recover-normality): Sanity check. + * emacs-lisp/bytecomp.el (byte-compile-out-toplevel): Don't turn (funcall '(lambda ..) ..) into ((lambda ..) ..). === modified file 'lisp/emacs-lisp/advice.el' --- lisp/emacs-lisp/advice.el 2012-11-09 04:10:16 +0000 +++ lisp/emacs-lisp/advice.el 2012-11-09 20:41:03 +0000 @@ -1,4 +1,4 @@ -;;; advice.el --- An overloading mechanism for Emacs Lisp functions +;;; advice.el --- An overloading mechanism for Emacs Lisp functions -*- lexical-binding: t -*- ;; Copyright (C) 1993-1994, 2000-2012 Free Software Foundation, Inc. @@ -1795,15 +1795,6 @@ `((put ',saved-function 'byte-opcode ',(get function 'byte-opcode)))))))) -(defun ad-save-real-definitions () - ;; Macro expansion will hardcode the values of the various byte-compiler - ;; properties into the compiled version of this function such that the - ;; proper values will be available at runtime without loading the compiler: - (ad-save-real-definition fset) - (ad-save-real-definition documentation)) - -(ad-save-real-definitions) - ;; @@ Advice info access fns: ;; ========================== @@ -1839,15 +1830,13 @@ ad-advised-functions))) (defmacro ad-do-advised-functions (varform &rest body) - "`dolist'-style iterator that maps over `ad-advised-functions'. -\(ad-do-advised-functions (VAR [RESULT-FORM]) + "`dolist'-style iterator that maps over advised functions. +\(ad-do-advised-functions (VAR) BODY-FORM...) On each iteration VAR will be bound to the name of an advised function \(a symbol)." (declare (indent 1)) - `(cl-dolist (,(car varform) - ad-advised-functions - ,(car (cdr varform))) + `(cl-dolist (,(car varform) ad-advised-functions) (setq ,(car varform) (intern (car ,(car varform)))) ,@body)) @@ -1866,7 +1855,7 @@ (defmacro ad-is-advised (function) "Return non-nil if FUNCTION has any advice info associated with it. This does not mean that the advice is also active." - (list 'ad-get-advice-info-macro function)) + `(ad-get-advice-info-macro ,function)) (defun ad-initialize-advice-info (function) "Initialize the advice info for FUNCTION. @@ -1949,7 +1938,7 @@ (defun ad-has-any-advice (function) "True if the advice info of FUNCTION defines at least one advice." (and (ad-is-advised function) - (cl-dolist (class ad-advice-classes nil) + (cl-dolist (class ad-advice-classes) (if (ad-get-advice-info-field function class) (cl-return t))))) @@ -1989,12 +1978,12 @@ ;; appropriate, especially in a safe version of `fset'. ;; For now define `ad-activate-internal' to the dummy definition: -(defun ad-activate-internal (function &optional compile) +(defun ad-activate-internal (_function &optional _compile) "Automatic advice activation is disabled. `ad-start-advice' enables it." nil) ;; This is just a copy of the above: -(defun ad-activate-internal-off (function &optional compile) +(defun ad-activate-internal-off (_function &optional _compile) "Automatic advice activation is disabled. `ad-start-advice' enables it." nil) @@ -2008,7 +1997,7 @@ (defun ad-safe-fset (symbol definition) "A safe `fset' which will never call `ad-activate-internal' recursively." (ad-with-auto-activation-disabled - (ad-real-fset symbol definition))) + (fset symbol definition))) ;; @@ Access functions for original definitions: @@ -2052,7 +2041,7 @@ (error "ad-read-advised-function: There are no advised functions")) (setq default (or default - ;; Prefer func name at point, if it's in ad-advised-functions etc. + ;; Prefer func name at point, if it's an advised function etc. (let ((function (progn (require 'help) (function-called-at-point)))) @@ -2061,24 +2050,20 @@ (or (null predicate) (funcall predicate function)) function)) - (ad-do-advised-functions (function) - (if (or (null predicate) - (funcall predicate function)) - (cl-return function))) + (cl-block nil + (ad-do-advised-functions (function) + (if (or (null predicate) + (funcall predicate function)) + (cl-return function)))) (error "ad-read-advised-function: %s" "There are no qualifying advised functions"))) - (let* ((ad-pReDiCaTe predicate) - (function + (let* ((function (completing-read (format "%s (default %s): " (or prompt "Function") default) ad-advised-functions (if predicate - (function - (lambda (function) - ;; Oops, no closures - the joys of dynamic scoping: - ;; `predicate' clashed with the `predicate' argument - ;; of `completing-read'..... - (funcall ad-pReDiCaTe (intern (car function)))))) + (lambda (function) + (funcall predicate (intern (car function))))) t))) (if (equal function "") (if (ad-is-advised default) @@ -2376,10 +2361,8 @@ (cdr definition)) (t nil))) -(defun ad-arglist (definition &optional name) - "Return the argument list of DEFINITION. -If DEFINITION could be from a subr then its NAME should be -supplied to make subr arglist lookup more efficient." +(defun ad-arglist (definition) + "Return the argument list of DEFINITION." (require 'help-fns) (help-function-arglist (if (or (ad-macro-p definition) (ad-advice-p definition)) @@ -2391,7 +2374,7 @@ "Return the unexpanded docstring of DEFINITION." (let ((docstring (if (ad-compiled-p definition) - (ad-real-documentation definition t) + (documentation definition t) (car (cdr (cdr (ad-lambda-expression definition))))))) (if (or (stringp docstring) (natnump docstring)) @@ -2475,6 +2458,7 @@ (ad-macro-p (symbol-function function))) (not (ad-compiled-p (symbol-function function))))) +(defvar warning-suppress-types) ;From warnings.el. (defun ad-compile-function (function) "Byte-compiles FUNCTION (or macro) if it is not yet compiled." (interactive "aByte-compile function: ") @@ -2605,24 +2589,20 @@ (let ((values-index 0) argument-access set-forms) (while (setq argument-access (ad-access-argument arglist index)) - (if (symbolp argument-access) - (setq set-forms - (cons (ad-set-argument - arglist index - (ad-element-access values-index 'ad-vAlUeS)) - set-forms)) - (setq set-forms - (cons (if (= (car argument-access) 0) - (list 'setq - (car (cdr argument-access)) - (ad-list-access values-index 'ad-vAlUeS)) - (list 'setcdr - (ad-list-access (1- (car argument-access)) - (car (cdr argument-access))) - (ad-list-access values-index 'ad-vAlUeS))) - set-forms)) - ;; terminate loop - (setq arglist nil)) + (push (if (symbolp argument-access) + (ad-set-argument + arglist index + (ad-element-access values-index 'ad-vAlUeS)) + (setq arglist nil) ;; Terminate loop. + (if (= (car argument-access) 0) + `(setq + ,(car (cdr argument-access)) + ,(ad-list-access values-index 'ad-vAlUeS)) + `(setcdr + ,(ad-list-access (1- (car argument-access)) + (car (cdr argument-access))) + ,(ad-list-access values-index 'ad-vAlUeS)))) + set-forms) (setq index (1+ index)) (setq values-index (1+ values-index))) (if (null set-forms) @@ -2631,8 +2611,8 @@ (if (= (length set-forms) 1) ;; For exactly one set-form we can use values-form directly,... (ad-substitute-tree - (function (lambda (form) (eq form 'ad-vAlUeS))) - (function (lambda (form) values-form)) + (lambda (form) (eq form 'ad-vAlUeS)) + (lambda (_form) values-form) (car set-forms)) ;; ...if we have more we have to bind it to a variable: `(let ((ad-vAlUeS ,values-form)) @@ -2702,11 +2682,10 @@ (cond (need-apply ;; `apply' can take care of that directly: (append source-reqopt-args (list source-rest-arg))) - (t (mapcar (function - (lambda (arg) - (setq target-arg-index (1+ target-arg-index)) - (ad-get-argument - source-arglist target-arg-index))) + (t (mapcar (lambda (_arg) + (setq target-arg-index (1+ target-arg-index)) + (ad-get-argument + source-arglist target-arg-index)) (append target-reqopt-args (and target-rest-arg ;; If we have a rest arg gobble up @@ -2757,7 +2736,7 @@ (let* ((origdef (ad-real-orig-definition function)) (origdoc ;; Retrieve raw doc, key substitution will be taken care of later: - (ad-real-documentation origdef t))) + (documentation origdef t))) (ad--make-advised-docstring origdoc function style))) (defun ad--make-advised-docstring (origdoc function &optional style) @@ -2771,7 +2750,7 @@ (let* ((origdef (ad-real-orig-definition function)) (origtype (symbol-name (ad-definition-type origdef))) (usage (help-split-fundoc origdoc function)) - paragraphs advice-docstring ad-usage) + paragraphs advice-docstring) (setq usage (if (null usage) t (setq origdoc (cdr usage)) (car usage))) (if origdoc (setq paragraphs (list origdoc))) (unless (eq style 'plain) @@ -2834,7 +2813,7 @@ (orig-special-form-p (ad-special-form-p origdef)) (orig-macro-p (ad-macro-p origdef)) ;; Construct the individual pieces that we need for assembly: - (orig-arglist (ad-arglist origdef function)) + (orig-arglist (ad-arglist origdef)) (advised-arglist (or (ad-advised-arglist function) orig-arglist)) (advised-interactive-form (ad-advised-interactive-form function)) @@ -2929,8 +2908,8 @@ (setq around-form-protected t)) (setq around-form (ad-substitute-tree - (function (lambda (form) (eq form 'ad-do-it))) - (function (lambda (form) around-form)) + (lambda (form) (eq form 'ad-do-it)) + (lambda (_form) around-form) (macroexp-progn (ad-body-forms (ad-advice-definition advice)))))) (setq after-forms @@ -3065,10 +3044,10 @@ (mapcar (function (lambda (advice) (ad-advice-name advice))) (ad-get-enabled-advices function 'after)) (ad-definition-type original-definition) - (if (equal (ad-arglist original-definition function) + (if (equal (ad-arglist original-definition) (ad-arglist cached-definition)) t - (ad-arglist original-definition function)) + (ad-arglist original-definition)) (if (eq (ad-definition-type original-definition) 'function) (equal (interactive-form original-definition) (interactive-form cached-definition)))))) @@ -3113,7 +3092,7 @@ (and (eq (nth 3 cache-id) (ad-definition-type original-definition)) (setq code 'arglist-mismatch) (equal (if (eq (nth 4 cache-id) t) - (ad-arglist original-definition function) + (ad-arglist original-definition) (nth 4 cache-id) ) (ad-arglist cached-definition)) (setq code 'interactive-form-mismatch) @@ -3227,7 +3206,7 @@ (ad-safe-fset 'ad-make-advised-definition-docstring 'ad-make-freeze-docstring) ;; Make sure `unique-origname' is used as the origname: - (ad-safe-fset 'ad-make-origname (lambda (x) unique-origname)) + (ad-safe-fset 'ad-make-origname (lambda (_x) unique-origname)) ;; No we reset all current advice information to nil and ;; generate an advised definition that's solely determined ;; by ADVICE and the current origdef of FUNCTION: @@ -3677,28 +3656,24 @@ ;; Make forms to redefine functions to their ;; original definitions if they are advised: (setq index -1) - (mapcar - (function - (lambda (function) - (setq index (1+ index)) - `(ad-safe-fset - ',function - (or (ad-get-orig-definition ',function) - ,(car (nth index current-bindings)))))) - functions)) + (mapcar (lambda (function) + (setq index (1+ index)) + `(ad-safe-fset + ',function + (or (ad-get-orig-definition ',function) + ,(car (nth index current-bindings))))) + functions)) ,@body) ,@(progn ;; Make forms to back-define functions to the definitions ;; they had outside this macro call: (setq index -1) - (mapcar - (function - (lambda (function) - (setq index (1+ index)) - `(ad-safe-fset - ',function - ,(car (nth index current-bindings))))) - functions)))))) + (mapcar (lambda (function) + (setq index (1+ index)) + `(ad-safe-fset + ',function + ,(car (nth index current-bindings)))) + functions)))))) ;; @@ Starting, stopping and recovering from the advice package magic: @@ -3727,7 +3702,9 @@ (ad-set-advice-info 'ad-activate-internal nil) (ad-safe-fset 'ad-activate-internal 'ad-activate-internal-off) (ad-recover-all) - (setq ad-advised-functions nil)) + (ad-do-advised-functions (function) + (message "Oops! Left over advised function %S" function) + (ad-pop-advised-function function))) (ad-start-advice) ------------------------------------------------------------ revno: 110858 committer: Jan D. branch nick: trunk timestamp: Fri 2012-11-09 20:47:28 +0100 message: * image.c (xpm_make_color_table_h): Change to hashtest_equal. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-11-09 15:44:07 +0000 +++ src/ChangeLog 2012-11-09 19:47:28 +0000 @@ -1,5 +1,7 @@ 2012-11-09 Jan Djärv + * image.c (xpm_make_color_table_h): Change to hashtest_equal. + * nsfont.m (Qcondensed, Qexpanded): New variables. (ns_descriptor_to_entity): Restore Qcondensed, Qexpanded setting. (syms_of_nsfont): Defsym Qcondensed, Qexpanded. === modified file 'src/image.c' --- src/image.c 2012-11-08 19:52:28 +0000 +++ src/image.c 2012-11-09 19:47:28 +0000 @@ -3731,7 +3731,7 @@ { *put_func = xpm_put_color_table_h; *get_func = xpm_get_color_table_h; - return make_hash_table (hashtest_eql, make_number (DEFAULT_HASH_SIZE), + return make_hash_table (hashtest_equal, make_number (DEFAULT_HASH_SIZE), make_float (DEFAULT_REHASH_SIZE), make_float (DEFAULT_REHASH_THRESHOLD), Qnil); ------------------------------------------------------------ revno: 110857 committer: Stefan Monnier branch nick: trunk timestamp: Fri 2012-11-09 10:56:51 -0500 message: * lisp/emacs-lisp/bytecomp.el (byte-compile-out-toplevel): Don't turn (funcall '(lambda ..) ..) into ((lambda ..) ..). diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-11-09 05:48:05 +0000 +++ lisp/ChangeLog 2012-11-09 15:56:51 +0000 @@ -1,15 +1,20 @@ +2012-11-09 Stefan Monnier + + * emacs-lisp/bytecomp.el (byte-compile-out-toplevel): Don't turn + (funcall '(lambda ..) ..) into ((lambda ..) ..). + 2012-11-09 Vincent Belaïche * ses.el: symbol to coordinate mapping is made by symbol property - `ses-cell'. This means that the same mapping is done for all SES - sheets. That is good enough for cells with standard A1 names, but - not for named cell. So a hash map is added for those - latter. - (defconst ses-localvars): added local variable ses--named-cell-hashmap + `ses-cell'. This means that the same mapping is done for all SES + sheets. That is good enough for cells with standard A1 names, but + not for named cell. So a hash map is added for the latter. + (defconst ses-localvars): Add local variable ses--named-cell-hashmap (ses-sym-rowcol): Use hashmap for named cell. (ses-is-cell-sym-p): New defun. (ses-decode-cell-symbol): New defun. - (ses-create-cell-variable): Add cell to hashmap when name is not A1-like. + (ses-create-cell-variable): Add cell to hashmap when name is not + A1-like. (ses-rename-cell): Check that cell new name is not already in spreadsheet with the use of ses-is-cell-sym-p (ses-rename-cell): Use hash map for named cells, but accept also @@ -120,8 +125,8 @@ 2012-11-05 Agustín Martín Domingo - * textmodes/ispell.el (ispell-program-name): Update - spellchecker parameters when customized. + * textmodes/ispell.el (ispell-program-name): + Update spellchecker parameters when customized. 2012-11-04 Glenn Morris @@ -515,7 +520,7 @@ 2012-10-19 Stefan Monnier * minibuffer.el (minibuffer-force-complete): Make the next completion use - the same completion-field (bug@12221). + the same completion-field (bug#12221). 2012-10-19 Martin Rudalics === modified file 'lisp/emacs-lisp/bytecomp.el' --- lisp/emacs-lisp/bytecomp.el 2012-11-08 14:58:15 +0000 +++ lisp/emacs-lisp/bytecomp.el 2012-11-09 15:56:51 +0000 @@ -2823,7 +2823,8 @@ (setq body (nreverse body)) (setq body (list (if (and (eq tmp 'funcall) - (eq (car-safe (car body)) 'quote)) + (eq (car-safe (car body)) 'quote) + (symbolp (nth 1 (car body)))) (cons (nth 1 (car body)) (cdr body)) (cons tmp body)))) (or (eq output-type 'file) ------------------------------------------------------------ revno: 110856 committer: Jan D. branch nick: trunk timestamp: Fri 2012-11-09 16:44:07 +0100 message: * nsfont.m (Qcondensed, Qexpanded): New variables. (ns_descriptor_to_entity): Restore Qcondensed, Qexpanded setting. (syms_of_nsfont): Defsym Qcondensed, Qexpanded. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-11-09 14:45:15 +0000 +++ src/ChangeLog 2012-11-09 15:44:07 +0000 @@ -1,3 +1,9 @@ +2012-11-09 Jan Djärv + + * nsfont.m (Qcondensed, Qexpanded): New variables. + (ns_descriptor_to_entity): Restore Qcondensed, Qexpanded setting. + (syms_of_nsfont): Defsym Qcondensed, Qexpanded. + 2012-11-09 Dmitry Antipov Fix recently introduced crash on MS-Windows (Bug#12839). === modified file 'src/nsfont.m' --- src/nsfont.m 2012-11-09 06:36:51 +0000 +++ src/nsfont.m 2012-11-09 15:44:07 +0000 @@ -48,6 +48,7 @@ extern Lisp_Object Qns; extern Lisp_Object Qnormal, Qbold, Qitalic; static Lisp_Object Qapple, Qroman, Qmedium; +static Lisp_Object Qcondensed, Qexpanded; extern Lisp_Object Qappend; extern float ns_antialias_threshold; extern int ns_tmp_flags; @@ -200,6 +201,9 @@ /* FONT_SET_STYLE (font_entity, FONT_SLANT_INDEX, make_number (100 + 100 * ns_attribute_fvalue (desc, NSFontSlantTrait)));*/ + FONT_SET_STYLE (font_entity, FONT_WIDTH_INDEX, + traits & NSFontCondensedTrait ? Qcondensed : + traits & NSFontExpandedTrait ? Qexpanded : Qnormal); /* FONT_SET_STYLE (font_entity, FONT_WIDTH_INDEX, make_number (100 + 100 * ns_attribute_fvalue (desc, NSFontWidthTrait)));*/ @@ -1508,6 +1512,8 @@ { nsfont_driver.type = Qns; register_font_driver (&nsfont_driver, NULL); + DEFSYM (Qcondensed, "condensed"); + DEFSYM (Qexpanded, "expanded"); DEFSYM (Qapple, "apple"); DEFSYM (Qroman, "roman"); DEFSYM (Qmedium, "medium"); ------------------------------------------------------------ revno: 110855 committer: Dmitry Antipov branch nick: trunk timestamp: Fri 2012-11-09 18:45:15 +0400 message: Fix recently introduced crash on MS-Windows (Bug#12839). * w32term.h (struct scroll_bar): Use convenient header. (SCROLL_BAR_VEC_SIZE): Remove. * w32term.c (x_scroll_bar_create): Use VECSIZE. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-11-09 11:38:31 +0000 +++ src/ChangeLog 2012-11-09 14:45:15 +0000 @@ -1,5 +1,12 @@ 2012-11-09 Dmitry Antipov + Fix recently introduced crash on MS-Windows (Bug#12839). + * w32term.h (struct scroll_bar): Use convenient header. + (SCROLL_BAR_VEC_SIZE): Remove. + * w32term.c (x_scroll_bar_create): Use VECSIZE. + +2012-11-09 Dmitry Antipov + Tweak last vectorlike_header change. * alloc.c (struct Lisp_Vectorlike_Free): Special type to represent vectorlike object on the free list. This is introduced to avoid === modified file 'src/w32term.c' --- src/w32term.c 2012-10-08 13:46:03 +0000 +++ src/w32term.c 2012-11-09 14:45:15 +0000 @@ -3626,7 +3626,7 @@ HWND hwnd; SCROLLINFO si; struct scroll_bar *bar - = XSCROLL_BAR (Fmake_vector (make_number (SCROLL_BAR_VEC_SIZE), Qnil)); + = XSCROLL_BAR (Fmake_vector (make_number (VECSIZE (struct scroll_bar)), Qnil)); Lisp_Object barobj; block_input (); === modified file 'src/w32term.h' --- src/w32term.h 2012-10-17 19:02:44 +0000 +++ src/w32term.h 2012-11-09 14:45:15 +0000 @@ -415,9 +415,8 @@ struct scroll_bar { - /* These fields are shared by all vectors. */ - EMACS_INT size_from_Lisp_Vector_struct; - struct Lisp_Vector *next_from_Lisp_Vector_struct; + /* This field is shared by all vectors. */ + struct vectorlike_header header; /* The window we're a scroll bar for. */ Lisp_Object window; @@ -460,12 +459,6 @@ Lisp_Object fringe_extended_p; }; -/* The number of elements a vector holding a struct scroll_bar needs. */ -#define SCROLL_BAR_VEC_SIZE \ - ((sizeof (struct scroll_bar) \ - - sizeof (EMACS_INT) - sizeof (struct Lisp_Vector *)) \ - / word_size) - /* Turning a lisp vector value into a pointer to a struct scroll_bar. */ #define XSCROLL_BAR(vec) ((struct scroll_bar *) XVECTOR (vec)) ------------------------------------------------------------ revno: 110854 committer: Dmitry Antipov branch nick: trunk timestamp: Fri 2012-11-09 15:38:31 +0400 message: Tweak last vectorlike_header change. * alloc.c (struct Lisp_Vectorlike_Free): Special type to represent vectorlike object on the free list. This is introduced to avoid some (but not all) pointer casting and aliasing problems, see http://lists.gnu.org/archive/html/emacs-devel/2012-11/msg00105.html. * .gdbinit (pvectype, pvecsize): New commands to examine vectorlike objects. (xvectype, xvecsize): Use them to examine Lisp_Object values. diff: === modified file 'src/.gdbinit' --- src/.gdbinit 2012-11-08 14:10:28 +0000 +++ src/.gdbinit 2012-11-09 11:38:31 +0000 @@ -650,9 +650,8 @@ a second line gives the more precise type. end -define xvectype - xgetptr $ - set $size = ((struct Lisp_Vector *) $ptr)->header.size +define pvectype + set $size = ((struct Lisp_Vector *) $arg0)->header.size if ($size & PSEUDOVECTOR_FLAG) output (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_AREA_BITS) else @@ -660,14 +659,22 @@ end echo \n end +document pvectype +Print the subtype of vectorlike object. +Takes one argument, a pointer to an object. +end + +define xvectype + xgetptr $ + pvectype $ptr +end document xvectype -Print the type or vector subtype of $. -This command assumes that $ is a vector or pseudovector. +Print the subtype of vectorlike object. +This command assumes that $ is a Lisp_Object. end -define xvecsize - xgetptr $ - set $size = ((struct Lisp_Vector *) $ptr)->header.size +define pvecsize + set $size = ((struct Lisp_Vector *) $arg0)->header.size if ($size & PSEUDOVECTOR_FLAG) output ($size & PSEUDOVECTOR_SIZE_MASK) echo \n @@ -677,9 +684,18 @@ end echo \n end +document pvecsize +Print the size of vectorlike object. +Takes one argument, a pointer to an object. +end + +define xvecsize + xgetptr $ + pvecsize $ptr +end document xvecsize -Print the size or vector subtype of $. -This command assumes that $ is a vector or pseudovector. +Print the size of $ +This command assumes that $ is a Lisp_Object. end define xmisctype === modified file 'src/ChangeLog' --- src/ChangeLog 2012-11-09 06:36:51 +0000 +++ src/ChangeLog 2012-11-09 11:38:31 +0000 @@ -1,3 +1,14 @@ +2012-11-09 Dmitry Antipov + + Tweak last vectorlike_header change. + * alloc.c (struct Lisp_Vectorlike_Free): Special type to represent + vectorlike object on the free list. This is introduced to avoid + some (but not all) pointer casting and aliasing problems, see + http://lists.gnu.org/archive/html/emacs-devel/2012-11/msg00105.html. + * .gdbinit (pvectype, pvecsize): New commands to examine vectorlike + objects. + (xvectype, xvecsize): Use them to examine Lisp_Object values. + 2012-11-09 Jan Djärv * nsfont.m (ns_descriptor_to_entity): Qcondesed and Qexpanded has === modified file 'src/alloc.c' --- src/alloc.c 2012-11-08 19:12:23 +0000 +++ src/alloc.c 2012-11-09 11:38:31 +0000 @@ -2611,16 +2611,18 @@ #define VINDEX(nbytes) (((nbytes) - VBLOCK_BYTES_MIN) / roundup_size) -/* When V is on the free list, first word after header is used as a pointer - to next vector on the free list. It might be done in a better way with: - - (*(struct Lisp_Vector **)&(v->contents[0])) - - but this breaks GCC's strict-aliasing rules (which looks more relaxed - for char and void pointers). */ - -#define NEXT_IN_FREE_LIST(v) \ - (*(struct Lisp_Vector **)((char *) v + header_size)) +/* This special type is used to represent any block-allocated vectorlike + object on the free list. */ + +struct Lisp_Vectorlike_Free +{ + struct vectorlike_header header; + struct Lisp_Vector *next; +}; + +/* When V is on the free list, it's always treated as Lisp_Vectorlike_Free. */ + +#define NEXT_IN_FREE_LIST(v) ((struct Lisp_Vectorlike_Free *) v)->next /* Common shortcut to setup vector on a free list. */ ------------------------------------------------------------ revno: 110853 committer: Jan D. branch nick: trunk timestamp: Fri 2012-11-09 07:36:51 +0100 message: * nsfont.m (ns_descriptor_to_entity): Qcondesed and Qexpanded has been removed, so remove them here also. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-11-09 04:10:16 +0000 +++ src/ChangeLog 2012-11-09 06:36:51 +0000 @@ -1,3 +1,8 @@ +2012-11-09 Jan Djärv + + * nsfont.m (ns_descriptor_to_entity): Qcondesed and Qexpanded has + been removed, so remove them here also. + 2012-11-09 Stefan Monnier * doc.c (Fdocumentation): Handle new property === modified file 'src/nsfont.m' --- src/nsfont.m 2012-11-08 19:51:07 +0000 +++ src/nsfont.m 2012-11-09 06:36:51 +0000 @@ -46,7 +46,7 @@ #define NSFONT_TRACE 0 extern Lisp_Object Qns; -extern Lisp_Object Qnormal, Qbold, Qitalic, Qcondensed, Qexpanded; +extern Lisp_Object Qnormal, Qbold, Qitalic; static Lisp_Object Qapple, Qroman, Qmedium; extern Lisp_Object Qappend; extern float ns_antialias_threshold; @@ -200,9 +200,6 @@ /* FONT_SET_STYLE (font_entity, FONT_SLANT_INDEX, make_number (100 + 100 * ns_attribute_fvalue (desc, NSFontSlantTrait)));*/ - FONT_SET_STYLE (font_entity, FONT_WIDTH_INDEX, - traits & NSFontCondensedTrait ? Qcondensed : - traits & NSFontExpandedTrait ? Qexpanded : Qnormal); /* FONT_SET_STYLE (font_entity, FONT_WIDTH_INDEX, make_number (100 + 100 * ns_attribute_fvalue (desc, NSFontWidthTrait)));*/