Now on revision 110853. ------------------------------------------------------------ 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)));*/ ------------------------------------------------------------ revno: 110852 committer: Vincent Belaïche branch nick: trunk timestamp: Fri 2012-11-09 06:48:05 +0100 message: * ses.el: Use hash map for getting named cells coordinates. 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-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-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 renaming back to A1-like. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-11-09 04:10:16 +0000 +++ lisp/ChangeLog 2012-11-09 05:48:05 +0000 @@ -1,3 +1,20 @@ +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-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-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 + renaming back to A1-like. + 2012-11-09 Stefan Monnier * emacs-lisp/advice.el: Use new dynamic docstrings. === modified file 'lisp/ses.el' --- lisp/ses.el 2012-09-07 08:58:31 +0000 +++ lisp/ses.el 2012-11-09 05:48:05 +0000 @@ -278,6 +278,7 @@ ses--default-printer ses--deferred-narrow ses--deferred-recalc ses--deferred-write ses--file-format + ses--named-cell-hashmap (ses--header-hscroll . -1) ; Flag for "initial recalc needed" ses--header-row ses--header-string ses--linewidth ses--numcols ses--numrows ses--symbolic-formulas @@ -511,9 +512,22 @@ `(aref ses--col-printers ,col)) (defmacro ses-sym-rowcol (sym) - "From a cell-symbol SYM, gets the cons (row . col). A1 => (0 . 0). -Result is nil if SYM is not a symbol that names a cell." - `(and (symbolp ,sym) (get ,sym 'ses-cell))) + "From a cell-symbol SYM, gets the cons (row . col). A1 => (0 . 0). Result +is nil if SYM is not a symbol that names a cell." + `(let ((rc (and (symbolp ,sym) (get ,sym 'ses-cell)))) + (if (eq rc :ses-named) + (gethash ,sym ses--named-cell-hashmap) + rc))) + +(defun ses-is-cell-sym-p (sym) + "Check whether SYM point at a cell of this spread sheet." + (let ((rowcol (get sym 'ses-cell))) + (and rowcol + (if (eq rowcol :ses-named) + (and ses--named-cell-hashmap (gethash sym ses--named-cell-hashmap)) + (and (< (car rowcol) ses--numrows) + (< (cdr rowcol) ses--numcols) + (eq (ses-cell-symbol (car rowcol) (cdr rowcol)) sym)))))) (defmacro ses-cell (sym value formula printer references) "Load a cell SYM from the spreadsheet file. Does not recompute VALUE from @@ -682,6 +696,28 @@ "Produce a symbol that names the cell (ROW,COL). (0,0) => 'A1." (intern (concat (ses-column-letter col) (number-to-string (1+ row))))) +(defun ses-decode-cell-symbol (str) + "Decode a symbol \"A1\" => (0,0). Returns `nil' if STR is not a + canonical cell name. Does not save match data." + (let (case-fold-search) + (and (string-match "\\`\\([A-Z]+\\)\\([0-9]+\\)\\'" str) + (let* ((col-str (match-string-no-properties 1 str)) + (col 0) + (col-offset 0) + (col-base 1) + (col-idx (1- (length col-str))) + (row (1- (string-to-number (match-string-no-properties 2 str))))) + (and (>= row 0) + (progn + (while + (progn + (setq col (+ col (* (- (aref col-str col-idx) ?A) col-base)) + col-base (* col-base 26) + col-idx (1- col-idx)) + (and (>= col-idx 0) + (setq col (+ col col-base))))) + (cons row col))))))) + (defun ses-create-cell-variable-range (minrow maxrow mincol maxcol) "Create buffer-local variables for cells. This is undoable." (push `(apply ses-destroy-cell-variable-range ,minrow ,maxrow ,mincol ,maxcol) @@ -704,7 +740,11 @@ Return nil in case of failure." (unless (local-variable-p sym) (make-local-variable sym) - (put sym 'ses-cell (cons row col)))) + (if (let (case-fold-search) (string-match "\\`[A-Z]+[0-9]+\\'" (symbol-name sym))) + (put sym 'ses-cell (cons row col)) + (put sym 'ses-cell :ses-named) + (setq ses--named-cell-hashmap (or ses--named-cell-hashmap (make-hash-table :test 'eq))) + (puthash sym (cons row col) ses--named-cell-hashmap)))) ;; We do not delete the ses-cell properties for the cell-variables, in ;; case a formula that refers to this cell is in the kill-ring and is @@ -3211,27 +3251,36 @@ (defun ses-rename-cell (new-name &optional cell) "Rename current cell." (interactive "*SEnter new name: ") - (and (local-variable-p new-name) - (ses-sym-rowcol new-name) - ;; this test is needed because ses-cell property of deleted cells - ;; is not deleted in case of subsequent undo - (memq new-name ses--renamed-cell-symb-list) - (error "Already a cell name")) - (and (boundp new-name) - (null (yes-or-no-p (format "`%S' is already bound outside this buffer, continue? " - new-name))) - (error "Already a bound cell name")) - (let* ((sym (if (ses-cell-p cell) + (or + (and (local-variable-p new-name) + (ses-is-cell-sym-p new-name) + (error "Already a cell name")) + (and (boundp new-name) + (null (yes-or-no-p (format "`%S' is already bound outside this buffer, continue? " + new-name))) + (error "Already a bound cell name"))) + (let* (curcell + (sym (if (ses-cell-p cell) (ses-cell-symbol cell) - (setq cell nil) + (setq cell nil + curcell t) (ses-check-curcell) ses--curcell)) (rowcol (ses-sym-rowcol sym)) (row (car rowcol)) - (col (cdr rowcol))) - (setq cell (or cell (ses-get-cell row col))) - (push `(ses-rename-cell ,(ses-cell-symbol cell) ,cell) buffer-undo-list) - (put new-name 'ses-cell rowcol) + (col (cdr rowcol)) + new-rowcol old-name) + (setq cell (or cell (ses-get-cell row col)) + old-name (ses-cell-symbol cell) + new-rowcol (ses-decode-cell-symbol (symbol-name new-name))) + (if new-rowcol + (if (equal new-rowcol rowcol) + (put new-name 'ses-cell rowcol) + (error "Not a valid name for this cell location")) + (setq ses--named-cell-hashmap (or ses--named-cell-hashmap (make-hash-table :test 'eq))) + (put new-name 'ses-cell :ses-named) + (puthash new-name rowcol ses--named-cell-hashmap)) + (push `(ses-rename-cell ,old-name ,cell) buffer-undo-list) ;; replace name by new name in formula of cells refering to renamed cell (dolist (ref (ses-cell-references cell)) (let* ((x (ses-sym-rowcol ref)) @@ -3251,9 +3300,8 @@ (push new-name ses--renamed-cell-symb-list) (set new-name (symbol-value sym)) (aset cell 0 new-name) - (put sym 'ses-cell nil) (makunbound sym) - (setq sym new-name) + (and curcell (setq ses--curcell new-name)) (let* ((pos (point)) (inhibit-read-only t) (col (current-column)) ------------------------------------------------------------ revno: 110851 committer: Stefan Monnier branch nick: trunk timestamp: Thu 2012-11-08 23:10:16 -0500 message: New property dynamic-docstring-function for docstrings. * src/doc.c (Fdocumentation): Handle new property dynamic-docstring-function to replace the old ad-advice-info. * lisp/emacs-lisp/advice.el: Use new dynamic docstrings. (ad-make-advised-definition-docstring, ad-advised-definition-p): Use dynamic-docstring-function instead of ad-advice-info. (ad--make-advised-docstring): New function extracted from ad-make-advised-docstring. (ad-make-advised-docstring): Use it. * lisp/progmodes/sql.el (sql--make-help-docstring): New function, extracted from sql-help. (sql-help): Use it with dynamic-docstring-function. diff: === modified file 'etc/NEWS' --- etc/NEWS 2012-11-03 19:14:22 +0000 +++ etc/NEWS 2012-11-09 04:10:16 +0000 @@ -29,6 +29,10 @@ * New Modes and Packages in Emacs 24.4 * Incompatible Lisp Changes in Emacs 24.4 * Lisp changes in Emacs 24.4 + +** Docstrings can be made dynamic by adding a `dynamic-docstring-function' +text-property on the first char. + * Changes in Emacs 24.4 on non-free operating systems === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-11-09 01:31:54 +0000 +++ lisp/ChangeLog 2012-11-09 04:10:16 +0000 @@ -1,5 +1,15 @@ 2012-11-09 Stefan Monnier + * emacs-lisp/advice.el: Use new dynamic docstrings. + (ad-make-advised-definition-docstring, ad-advised-definition-p): + Use dynamic-docstring-function instead of ad-advice-info. + (ad--make-advised-docstring): New function extracted from + ad-make-advised-docstring. + (ad-make-advised-docstring): Use it. + * progmodes/sql.el (sql--make-help-docstring): New function, extracted + from sql-help. + (sql-help): Use it with dynamic-docstring-function. + * env.el (env--substitute-vars-regexp): Don't use rx (for bootstrap). 2012-11-08 Stefan Monnier === modified file 'lisp/emacs-lisp/advice.el' --- lisp/emacs-lisp/advice.el 2012-10-26 18:01:30 +0000 +++ lisp/emacs-lisp/advice.el 2012-11-09 04:10:16 +0000 @@ -2414,13 +2414,15 @@ (if (ad-interactive-form definition) 1 0)) (cdr (cdr (ad-lambda-expression definition))))))) -(defun ad-make-advised-definition-docstring (function) +(defun ad-make-advised-definition-docstring (_function) "Make an identifying docstring for the advised definition of FUNCTION. Put function name into the documentation string so we can infer the name of the advised function from the docstring. This is needed to generate a proper advised docstring even if we are just given a definition (see the code for `documentation')." - (propertize "Advice doc string" 'ad-advice-info function)) + (eval-when-compile + (propertize "Advice doc string" 'dynamic-docstring-function + #'ad--make-advised-docstring))) (defun ad-advised-definition-p (definition) "Return non-nil if DEFINITION was generated from advice information." @@ -2429,7 +2431,7 @@ (ad-compiled-p definition)) (let ((docstring (ad-docstring definition))) (and (stringp docstring) - (get-text-property 0 'ad-advice-info docstring))))) + (get-text-property 0 'dynamic-docstring-function docstring))))) (defun ad-definition-type (definition) "Return symbol that describes the type of DEFINITION." @@ -2752,6 +2754,13 @@ (require 'help-fns) ;For help-split-fundoc and help-add-fundoc-usage. (defun ad-make-advised-docstring (function &optional style) + (let* ((origdef (ad-real-orig-definition function)) + (origdoc + ;; Retrieve raw doc, key substitution will be taken care of later: + (ad-real-documentation origdef t))) + (ad--make-advised-docstring origdoc function style))) + +(defun ad--make-advised-docstring (origdoc function &optional style) "Construct a documentation string for the advised FUNCTION. It concatenates the original documentation with the documentation strings of the individual pieces of advice which will be formatted @@ -2761,9 +2770,6 @@ in any of these classes." (let* ((origdef (ad-real-orig-definition function)) (origtype (symbol-name (ad-definition-type origdef))) - (origdoc - ;; Retrieve raw doc, key substitution will be taken care of later: - (ad-real-documentation origdef t)) (usage (help-split-fundoc origdoc function)) paragraphs advice-docstring ad-usage) (setq usage (if (null usage) t (setq origdoc (cdr usage)) (car usage))) @@ -2780,7 +2786,9 @@ (propertize ;; separate paragraphs with blank lines: (mapconcat 'identity (nreverse paragraphs) "\n\n") - 'ad-advice-info function))) + ;; FIXME: what is this for? + 'dynamic-docstring-function + #'ad--make-advised-docstring))) (help-add-fundoc-usage origdoc usage))) (defun ad-make-plain-docstring (function) === modified file 'lisp/progmodes/sql.el' --- lisp/progmodes/sql.el 2012-09-17 05:41:04 +0000 +++ lisp/progmodes/sql.el 2012-11-09 04:10:16 +0000 @@ -2802,8 +2802,12 @@ doc)) ;;;###autoload -(defun sql-help () - "Show short help for the SQL modes. +(eval + ;; FIXME: This dynamic-docstring-function trick doesn't work for byte-compiled + ;; functions, because of the lazy-loading of docstrings, which strips away + ;; text properties. + '(defun sql-help () + #("Show short help for the SQL modes. Use an entry function to open an interactive SQL buffer. This buffer is usually named `*SQL*'. The name of the major mode is SQLi. @@ -2834,32 +2838,23 @@ In this SQL buffer (SQL mode), you can send the region or the entire buffer to the interactive SQL buffer (SQLi mode). The results are appended to the SQLi buffer without disturbing your SQL buffer." + 0 1 (dynamic-docstring-function sql--make-help-docstring)) (interactive) - - ;; Insert references to loaded products into the help buffer string - (let ((doc (documentation 'sql-help t)) - changedp) - (setq changedp nil) - - ;; Insert FREE software list - (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]FREE\\s-*\n" doc 0) - (setq doc (replace-match (sql-help-list-products (match-string 1 doc) t) - t t doc 0) - changedp t)) - - ;; Insert non-FREE software list - (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]NONFREE\\s-*\n" doc 0) - (setq doc (replace-match (sql-help-list-products (match-string 1 doc) nil) - t t doc 0) - changedp t)) - - ;; If we changed the help text, save the change so that the help - ;; sub-system will see it - (when changedp - (put 'sql-help 'function-documentation doc))) - - ;; Call help on this function - (describe-function 'sql-help)) + (describe-function 'sql-help))) + +(defun sql--make-help-docstring (doc _fun) + "Insert references to loaded products into the help buffer string." + + ;; Insert FREE software list + (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]FREE\\s-*\n" doc 0) + (setq doc (replace-match (sql-help-list-products (match-string 1 doc) t) + t t doc 0))) + + ;; Insert non-FREE software list + (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]NONFREE\\s-*\n" doc 0) + (setq doc (replace-match (sql-help-list-products (match-string 1 doc) nil) + t t doc 0))) + doc) (defun sql-read-passwd (prompt &optional default) "Read a password using PROMPT. Optional DEFAULT is password to start with." === modified file 'src/ChangeLog' --- src/ChangeLog 2012-11-09 00:08:12 +0000 +++ src/ChangeLog 2012-11-09 04:10:16 +0000 @@ -1,3 +1,8 @@ +2012-11-09 Stefan Monnier + + * doc.c (Fdocumentation): Handle new property + dynamic-docstring-function to replace the old ad-advice-info. + 2012-11-09 Paul Eggert * fns.c (Qeql, hashtest_eq): Now static. === modified file 'src/doc.c' --- src/doc.c 2012-10-12 20:11:50 +0000 +++ src/doc.c 2012-11-09 04:10:16 +0000 @@ -21,7 +21,7 @@ #include #include -#include /* Must be after sys/types.h for USG*/ +#include /* Must be after sys/types.h for USG. */ #include #include @@ -42,7 +42,7 @@ static unsigned char *read_bytecode_pointer; -/* readchar in lread.c calls back here to fetch the next byte. +/* `readchar' in lread.c calls back here to fetch the next byte. If UNREADFLAG is 1, we unread a byte. */ int @@ -338,15 +338,9 @@ doc = Qnil; - if (SYMBOLP (function)) - { - Lisp_Object tem = Fget (function, Qfunction_documentation); - if (!NILP (tem)) - return Fdocumentation_property (function, Qfunction_documentation, - raw); - } - fun = Findirect_function (function, Qnil); + if (CONSP (fun) && EQ (XCAR (fun), Qmacro)) + fun = XCDR (fun); if (SUBRP (fun)) { if (XSUBR (fun)->doc == 0) @@ -400,8 +394,6 @@ else return Qnil; } - else if (EQ (funcar, Qmacro)) - return Fdocumentation (Fcdr (fun), raw); else goto oops; } @@ -411,16 +403,19 @@ xsignal1 (Qinvalid_function, fun); } - /* Check for an advised function. Its doc string - has an `ad-advice-info' text property. */ + /* Check for a dynamic docstring. These come with + a dynamic-docstring-function text property. */ if (STRINGP (doc)) { - Lisp_Object innerfunc; - innerfunc = Fget_text_property (make_number (0), - intern ("ad-advice-info"), + Lisp_Object func + = Fget_text_property (make_number (0), + intern ("dynamic-docstring-function"), doc); - if (! NILP (innerfunc)) - doc = call1 (intern ("ad-make-advised-docstring"), innerfunc); + if (!NILP (func)) + /* Pass both `doc' and `function' since `function' can be needed, and + finding `doc' can be annoying: calling `documentation' is not an + option because it would infloop. */ + doc = call2 (func, doc, function); } /* If DOC is 0, it's typically because of a dumped file missing @@ -528,6 +523,8 @@ { tem = Fcdr (Fcdr (fun)); if (CONSP (tem) && INTEGERP (XCAR (tem))) + /* FIXME: This modifies typically pure hash-cons'd data, so its + correctness is quite delicate. */ XSETCAR (tem, make_number (offset)); } else if (EQ (tem, Qmacro)) ------------------------------------------------------------ revno: 110850 committer: Stefan Monnier branch nick: trunk timestamp: Thu 2012-11-08 20:31:54 -0500 message: * lisp/env.el (env--substitute-vars-regexp): Don't use rx (for bootstrap). diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-11-08 19:50:08 +0000 +++ lisp/ChangeLog 2012-11-09 01:31:54 +0000 @@ -1,3 +1,7 @@ +2012-11-09 Stefan Monnier + + * env.el (env--substitute-vars-regexp): Don't use rx (for bootstrap). + 2012-11-08 Stefan Monnier * files.el (hack-one-local-variable--obsolete): New function. === modified file 'lisp/env.el' --- lisp/env.el 2012-11-08 15:10:08 +0000 +++ lisp/env.el 2012-11-09 01:31:54 +0000 @@ -58,10 +58,7 @@ (defvar setenv-history nil) (defconst env--substitute-vars-regexp - (rx "$" - (or (submatch-n 1 (1+ (regexp "[[:alnum:]_]"))) - (and "{" (submatch-n 1 (minimal-match (0+ anything))) "}") - "$"))) + "\\$\\(?:\\(?1:[[:alnum:]_]+\\)\\|{\\(?1:[^{}]+\\)}\\|\\$\\)") (defun substitute-env-vars (string &optional only-defined) "Substitute environment variables referred to in STRING. ------------------------------------------------------------ revno: 110849 committer: Paul Eggert branch nick: trunk timestamp: Thu 2012-11-08 16:08:12 -0800 message: * fns.c (Qeql, hashtest_eq): Now static. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-11-08 21:58:55 +0000 +++ src/ChangeLog 2012-11-09 00:08:12 +0000 @@ -1,3 +1,7 @@ +2012-11-09 Paul Eggert + + * fns.c (Qeql, hashtest_eq): Now static. + 2012-11-08 Stefan Monnier * lisp.h (XHASH): Redefine to be imperfect and fit in a Lisp int. === modified file 'src/fns.c' --- src/fns.c 2012-11-08 21:58:55 +0000 +++ src/fns.c 2012-11-09 00:08:12 +0000 @@ -3331,8 +3331,8 @@ /* Various symbols. */ -static Lisp_Object Qhash_table_p, Qkey, Qvalue; -Lisp_Object Qeq, Qeql, Qequal; +static Lisp_Object Qhash_table_p, Qkey, Qvalue, Qeql; +Lisp_Object Qeq, Qequal; Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold, QCweakness; static Lisp_Object Qhash_table_test, Qkey_or_value, Qkey_and_value; @@ -3424,7 +3424,8 @@ Low-level Functions ***********************************************************************/ -struct hash_table_test hashtest_eq, hashtest_eql, hashtest_equal; +static struct hash_table_test hashtest_eq; +struct hash_table_test hashtest_eql, hashtest_equal; /* Compare KEY1 which has hash code HASH1 and KEY2 with hash code HASH2 in hash table H using `eql'. Value is true if KEY1 and === modified file 'src/lisp.h' --- src/lisp.h 2012-11-08 21:58:55 +0000 +++ src/lisp.h 2012-11-09 00:08:12 +0000 @@ -2719,7 +2719,7 @@ extern void sweep_weak_hash_tables (void); extern Lisp_Object Qcursor_in_echo_area; extern Lisp_Object Qstring_lessp; -extern Lisp_Object QCsize, QCtest, QCweakness, Qequal, Qeq, Qeql; +extern Lisp_Object QCsize, QCtest, QCweakness, Qequal, Qeq; EMACS_UINT hash_string (char const *, ptrdiff_t); EMACS_UINT sxhash (Lisp_Object, int); Lisp_Object make_hash_table (struct hash_table_test, Lisp_Object, Lisp_Object, @@ -2727,7 +2727,7 @@ ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *); ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object, EMACS_UINT); -extern struct hash_table_test hashtest_eq, hashtest_eql, hashtest_equal; +extern struct hash_table_test hashtest_eql, hashtest_equal; extern Lisp_Object substring_both (Lisp_Object, ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t); ------------------------------------------------------------ revno: 110848 committer: Katsumi Yamaoka branch nick: trunk timestamp: Thu 2012-11-08 23:49:58 +0000 message: gnus-art.el (gnus-article-browse-html-parts): Always replace charset in meta tag with the one the part specifies in its header diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2012-11-03 01:26:25 +0000 +++ lisp/gnus/ChangeLog 2012-11-08 23:49:58 +0000 @@ -1,3 +1,8 @@ +2012-11-08 Katsumi Yamaoka + + * gnus-art.el (gnus-article-browse-html-parts): Always replace charset + in meta tag with the one the part specifies in its header. + 2012-11-02 Stephen Eglen * gnus-dired.el (gnus-dired-attach): Attach to last used message buffer === modified file 'lisp/gnus/gnus-art.el' --- lisp/gnus/gnus-art.el 2012-09-25 23:57:37 +0000 +++ lisp/gnus/gnus-art.el 2012-11-08 23:49:58 +0000 @@ -2877,7 +2877,7 @@ ;; Add a meta html tag to specify charset and a header. (cond (header - (let (title eheader body hcharset coding force-charset) + (let (title eheader body hcharset coding) (with-temp-buffer (mm-enable-multibyte) (setq case-fold-search t) @@ -2900,8 +2900,7 @@ charset) title (when title (mm-encode-coding-string title charset)) - body (mm-encode-coding-string content charset) - force-charset t) + body (mm-encode-coding-string content charset)) (setq hcharset (mm-find-mime-charset-region (point-min) (point-max))) (cond ((= (length hcharset) 1) @@ -2932,8 +2931,7 @@ body (mm-encode-coding-string (mm-decode-coding-string content body) - charset) - force-charset t))) + charset)))) (setq charset hcharset eheader (mm-encode-coding-string (buffer-string) coding) @@ -2947,7 +2945,7 @@ (mm-disable-multibyte) (insert body) (when charset - (mm-add-meta-html-tag handle charset force-charset)) + (mm-add-meta-html-tag handle charset t)) (when title (goto-char (point-min)) (unless (search-forward "" nil t) ------------------------------------------------------------ revno: 110847 committer: Stefan Monnier <monnier@iro.umontreal.ca> branch nick: trunk timestamp: Thu 2012-11-08 16:58:55 -0500 message: * src/lisp.h (XHASH): Redefine to be imperfect and fit in a Lisp int. * src/fns.c (hashfn_eq, hashfn_eql, sxhash): * src/profiler.c (hashfn_profiler): Don't use XUINT on non-integers. * src/buffer.c (compare_overlays): Use XLI rather than XHASH. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-11-08 21:43:34 +0000 +++ src/ChangeLog 2012-11-08 21:58:55 +0000 @@ -1,3 +1,10 @@ +2012-11-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * lisp.h (XHASH): Redefine to be imperfect and fit in a Lisp int. + * fns.c (hashfn_eq, hashfn_eql, sxhash): + * profiler.c (hashfn_profiler): Don't use XUINT on non-integers. + * buffer.c (compare_overlays): Use XLI rather than XHASH. + 2012-11-08 Paul Eggert <eggert@cs.ucla.edu> Use same hash function for hashfn_profiler as for hash_string etc. === modified file 'src/buffer.c' --- src/buffer.c 2012-11-08 14:10:28 +0000 +++ src/buffer.c 2012-11-08 21:58:55 +0000 @@ -3132,8 +3132,8 @@ between "equal" overlays. The result can still change between invocations of Emacs, but it won't change in the middle of `find_field' (bug#6830). */ - if (XHASH (s1->overlay) != XHASH (s2->overlay)) - return XHASH (s1->overlay) < XHASH (s2->overlay) ? -1 : 1; + if (!EQ (s1->overlay, s2->overlay)) + return XLI (s1->overlay) < XLI (s2->overlay) ? -1 : 1; return 0; } === modified file 'src/fns.c' --- src/fns.c 2012-11-08 21:43:34 +0000 +++ src/fns.c 2012-11-08 21:58:55 +0000 @@ -3479,7 +3479,7 @@ static EMACS_UINT hashfn_eq (struct hash_table_test *ht, Lisp_Object key) { - EMACS_UINT hash = XUINT (key) ^ XTYPE (key); + EMACS_UINT hash = XHASH (key) ^ XTYPE (key); return hash; } @@ -3494,7 +3494,7 @@ if (FLOATP (key)) hash = sxhash (key, 0); else - hash = XUINT (key) ^ XTYPE (key); + hash = XHASH (key) ^ XTYPE (key); return hash; } @@ -4173,7 +4173,7 @@ break; case Lisp_Misc: - hash = XUINT (obj); + hash = XHASH (obj); break; case Lisp_Symbol: @@ -4197,7 +4197,7 @@ else /* Others are `equal' if they are `eq', so let's take their address as hash. */ - hash = XUINT (obj); + hash = XHASH (obj); break; case Lisp_Cons: === modified file 'src/lisp.h' --- src/lisp.h 2012-11-08 21:43:34 +0000 +++ src/lisp.h 2012-11-08 21:58:55 +0000 @@ -454,9 +454,6 @@ For example, if tem is a Lisp_Object whose type is Lisp_Cons, XCONS (tem) is the struct Lisp_Cons * pointing to the memory for that cons. */ -/* Return a perfect hash of the Lisp_Object representation. */ -#define XHASH(a) XLI (a) - #if USE_LSB_TAG enum lsb_bits @@ -509,6 +506,11 @@ #endif /* not USE_LSB_TAG */ +/* Return a (Lisp-integer sized) hash of the Lisp_Object value. Happens to be + like XUINT right now, but XUINT should only be applied to objects we know + are integers. */ +#define XHASH(a) XUINT (a) + /* For integers known to be positive, XFASTINT sometimes provides faster retrieval and XSETFASTINT provides faster storage. If not, fallback on the non-accelerated path. */ @@ -524,7 +526,7 @@ # define XUNTAG(a, type) XPNTR (a) #endif -#define EQ(x, y) (XHASH (x) == XHASH (y)) +#define EQ(x, y) (XLI (x) == XLI (y)) /* Largest and smallest representable fixnum values. These are the C values. They are macros for use in static initializers. */ === modified file 'src/print.c' --- src/print.c 2012-11-08 19:12:23 +0000 +++ src/print.c 2012-11-08 21:58:55 +0000 @@ -798,7 +798,7 @@ else fprintf (stderr, "#<%s_LISP_OBJECT 0x%08"pI"x>\r\n", !valid ? "INVALID" : "SOME", - XHASH (arg)); + XLI (arg)); } === modified file 'src/profiler.c' --- src/profiler.c 2012-11-08 21:43:34 +0000 +++ src/profiler.c 2012-11-08 21:58:55 +0000 @@ -555,15 +555,15 @@ { Lisp_Object f = AREF (bt, i); EMACS_UINT hash1 - = (COMPILEDP (f) ? XUINT (AREF (f, COMPILED_BYTECODE)) + = (COMPILEDP (f) ? XHASH (AREF (f, COMPILED_BYTECODE)) : (CONSP (f) && CONSP (XCDR (f)) && EQ (Qclosure, XCAR (f))) - ? XUINT (XCDR (XCDR (f))) : XUINT (f)); + ? XHASH (XCDR (XCDR (f))) : XHASH (f)); hash = sxhash_combine (hash, hash1); } return (hash & INTMASK); } else - return XUINT (bt); + return XHASH (bt); } void ------------------------------------------------------------ revno: 110846 committer: Paul Eggert <eggert@cs.ucla.edu> branch nick: trunk timestamp: Thu 2012-11-08 13:43:34 -0800 message: Use same hash function for hashfn_profiler as for hash_string etc. * fns.c (SXHASH_COMBINE): Remove. All uses replaced by sxhash_combine. * lisp.h (sxhash_combine): New inline function, with the contents of the old SXHASH_COMBINE. * profiler.c (hashfn_profiler): Use it, instead of having a special hash function containing a comparison that always yields 1. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-11-08 21:02:10 +0000 +++ src/ChangeLog 2012-11-08 21:43:34 +0000 @@ -1,3 +1,12 @@ +2012-11-08 Paul Eggert <eggert@cs.ucla.edu> + + Use same hash function for hashfn_profiler as for hash_string etc. + * fns.c (SXHASH_COMBINE): Remove. All uses replaced by sxhash_combine. + * lisp.h (sxhash_combine): New inline function, with the contents + of the old SXHASH_COMBINE. + * profiler.c (hashfn_profiler): Use it, instead of having a + special hash function containing a comparison that always yields 1. + 2012-11-08 Stefan Monnier <monnier@iro.umontreal.ca> * xfaces.c (Qultra_light, Qreverse_oblique, Qreverse_italic) === modified file 'src/fns.c' --- src/fns.c 2012-11-08 19:12:23 +0000 +++ src/fns.c 2012-11-08 21:43:34 +0000 @@ -4036,13 +4036,6 @@ #define SXHASH_MAX_LEN 7 -/* Combine two integers X and Y for hashing. The result might not fit - into a Lisp integer. */ - -#define SXHASH_COMBINE(X, Y) \ - ((((EMACS_UINT) (X) << 4) + ((EMACS_UINT) (X) >> (BITS_PER_EMACS_INT - 4))) \ - + (EMACS_UINT) (Y)) - /* Hash X, returning a value that fits into a Lisp integer. */ #define SXHASH_REDUCE(X) \ ((((X) ^ (X) >> (BITS_PER_EMACS_INT - FIXNUM_BITS))) & INTMASK) @@ -4061,7 +4054,7 @@ while (p != end) { c = *p++; - hash = SXHASH_COMBINE (hash, c); + hash = sxhash_combine (hash, c); } return hash; @@ -4095,7 +4088,7 @@ u.val = val; memset (&u.val + 1, 0, sizeof u - sizeof u.val); for (i = 0; i < WORDS_PER_DOUBLE; i++) - hash = SXHASH_COMBINE (hash, u.word[i]); + hash = sxhash_combine (hash, u.word[i]); return SXHASH_REDUCE (hash); } @@ -4114,13 +4107,13 @@ list = XCDR (list), ++i) { EMACS_UINT hash2 = sxhash (XCAR (list), depth + 1); - hash = SXHASH_COMBINE (hash, hash2); + hash = sxhash_combine (hash, hash2); } if (!NILP (list)) { EMACS_UINT hash2 = sxhash (list, depth + 1); - hash = SXHASH_COMBINE (hash, hash2); + hash = sxhash_combine (hash, hash2); } return SXHASH_REDUCE (hash); @@ -4140,7 +4133,7 @@ for (i = 0; i < n; ++i) { EMACS_UINT hash2 = sxhash (AREF (vec, i), depth + 1); - hash = SXHASH_COMBINE (hash, hash2); + hash = sxhash_combine (hash, hash2); } return SXHASH_REDUCE (hash); @@ -4156,7 +4149,7 @@ n = min (SXHASH_MAX_LEN, XBOOL_VECTOR (vec)->header.size); for (i = 0; i < n; ++i) - hash = SXHASH_COMBINE (hash, XBOOL_VECTOR (vec)->data[i]); + hash = sxhash_combine (hash, XBOOL_VECTOR (vec)->data[i]); return SXHASH_REDUCE (hash); } === modified file 'src/lisp.h' --- src/lisp.h 2012-11-08 19:12:23 +0000 +++ src/lisp.h 2012-11-08 21:43:34 +0000 @@ -438,7 +438,7 @@ /* To calculate the memory footprint of the pseudovector, it's useful to store the size of non-Lisp area in word_size units here. */ PSEUDOVECTOR_REST_BITS = 12, - PSEUDOVECTOR_REST_MASK = (((1 << PSEUDOVECTOR_REST_BITS) - 1) + PSEUDOVECTOR_REST_MASK = (((1 << PSEUDOVECTOR_REST_BITS) - 1) << PSEUDOVECTOR_SIZE_BITS), /* Used to extract pseudovector subtype information. */ @@ -1284,6 +1284,15 @@ static double const DEFAULT_REHASH_SIZE = 1.5; +/* Combine two integers X and Y for hashing. The result might not fit + into a Lisp integer. */ + +LISP_INLINE EMACS_UINT +sxhash_combine (EMACS_UINT x, EMACS_UINT y) +{ + return (x << 4) + (x >> (BITS_PER_EMACS_INT - 4)) + y; +} + /* These structures are used for various misc types. */ struct Lisp_Misc_Any /* Supertype of all Misc types. */ === modified file 'src/profiler.c' --- src/profiler.c 2012-11-08 19:12:23 +0000 +++ src/profiler.c 2012-11-08 21:43:34 +0000 @@ -558,7 +558,7 @@ = (COMPILEDP (f) ? XUINT (AREF (f, COMPILED_BYTECODE)) : (CONSP (f) && CONSP (XCDR (f)) && EQ (Qclosure, XCAR (f))) ? XUINT (XCDR (XCDR (f))) : XUINT (f)); - hash = hash1 + (hash << 1) + (hash == (EMACS_INT) hash); + hash = sxhash_combine (hash, hash1); } return (hash & INTMASK); } ------------------------------------------------------------ revno: 110845 committer: Stefan Monnier <monnier@iro.umontreal.ca> branch nick: trunk timestamp: Thu 2012-11-08 16:02:10 -0500 message: * src/xfaces.c (Qultra_light, Qreverse_oblique, Qreverse_italic) (Qultra_condensed, Qextra_condensed, Qcondensed, Qsemi_condensed) (Qsemi_expanded, Qextra_expanded, Qexpanded, Qultra_expanded): Remove unused vars. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-11-08 19:52:28 +0000 +++ src/ChangeLog 2012-11-08 21:02:10 +0000 @@ -1,3 +1,10 @@ +2012-11-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * xfaces.c (Qultra_light, Qreverse_oblique, Qreverse_italic) + (Qultra_condensed, Qextra_condensed, Qcondensed, Qsemi_condensed) + (Qsemi_expanded, Qextra_expanded, Qexpanded, Qultra_expanded): + Remove unused vars. + 2012-11-08 Jan Djärv <jan.h.d@swipnet.se> * image.c (xpm_make_color_table_h): Fix compiler error because @@ -225,8 +232,8 @@ Remove EMACS_OUTQSIZE+sleep hack. * dispnew.c (update_frame_1): Remove hack for terminals slower - than 2400 bps, which throttled Emacs by having it sleep. This - code hasn't worked since at least 2007, when the multi-tty stuff + than 2400 bps, which throttled Emacs by having it sleep. + This code hasn't worked since at least 2007, when the multi-tty stuff was added, and anyway those old terminals are long dead. * systty.h (EMACS_OUTQSIZE): Remove; unused. The macro isn't used even without the dispnew.c change, as dispnew.c doesn't include systty.h. @@ -265,8 +272,8 @@ waitpid only on subprocesses that Emacs itself creates. * process.c (create_process, record_child_status_change): Don't use special value -1 in pid field, as the caller now must - know the pid rather than having the callee infer it. The - inference was sometimes incorrect anyway, due to another race. + know the pid rather than having the callee infer it. + The inference was sometimes incorrect anyway, due to another race. (create_process): Set new 'alive' member if child is created. (process_status_retrieved): New function. (record_child_status_change): Use it. @@ -427,8 +434,8 @@ 2012-10-29 Daniel Colascione <dancol@dancol.org> - * cygw32.h, cygw32.c (Qutf_16le, from_unicode, to_unicode): In - preparation for fixing bug#12739, move these functions from + * cygw32.h, cygw32.c (Qutf_16le, from_unicode, to_unicode): + In preparation for fixing bug#12739, move these functions from here... * coding.h, coding.c: ... to here, and compile them only when === modified file 'src/xfaces.c' --- src/xfaces.c 2012-11-06 13:26:20 +0000 +++ src/xfaces.c 2012-11-08 21:02:10 +0000 @@ -314,16 +314,10 @@ Lisp_Object Qnormal; Lisp_Object Qbold; static Lisp_Object Qline, Qwave; -static Lisp_Object Qultra_light, Qreverse_oblique, Qreverse_italic; Lisp_Object Qextra_light, Qlight; Lisp_Object Qsemi_light, Qsemi_bold, Qextra_bold, Qultra_bold; Lisp_Object Qoblique; Lisp_Object Qitalic; -static Lisp_Object Qultra_condensed, Qextra_condensed; -Lisp_Object Qcondensed; -static Lisp_Object Qsemi_condensed, Qsemi_expanded, Qextra_expanded; -Lisp_Object Qexpanded; -static Lisp_Object Qultra_expanded; static Lisp_Object Qreleased_button, Qpressed_button; static Lisp_Object QCstyle, QCcolor, QCline_width; Lisp_Object Qunspecified; /* used in dosfns.c */ @@ -6451,7 +6445,6 @@ DEFSYM (Qreleased_button, "released-button"); DEFSYM (Qpressed_button, "pressed-button"); DEFSYM (Qnormal, "normal"); - DEFSYM (Qultra_light, "ultra-light"); DEFSYM (Qextra_light, "extra-light"); DEFSYM (Qlight, "light"); DEFSYM (Qsemi_light, "semi-light"); @@ -6461,16 +6454,6 @@ DEFSYM (Qultra_bold, "ultra-bold"); DEFSYM (Qoblique, "oblique"); DEFSYM (Qitalic, "italic"); - DEFSYM (Qreverse_oblique, "reverse-oblique"); - DEFSYM (Qreverse_italic, "reverse-italic"); - DEFSYM (Qultra_condensed, "ultra-condensed"); - DEFSYM (Qextra_condensed, "extra-condensed"); - DEFSYM (Qcondensed, "condensed"); - DEFSYM (Qsemi_condensed, "semi-condensed"); - DEFSYM (Qsemi_expanded, "semi-expanded"); - DEFSYM (Qexpanded, "expanded"); - DEFSYM (Qextra_expanded, "extra-expanded"); - DEFSYM (Qultra_expanded, "ultra-expanded"); DEFSYM (Qbackground_color, "background-color"); DEFSYM (Qforeground_color, "foreground-color"); DEFSYM (Qunspecified, "unspecified"); ------------------------------------------------------------ revno: 110844 committer: Jan D. <jan.h.d@swipnet.se> branch nick: trunk timestamp: Thu 2012-11-08 20:52:28 +0100 message: * image.c (xpm_make_color_table_h): Fix compiler error because make_hash_table changed. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-11-08 19:51:07 +0000 +++ src/ChangeLog 2012-11-08 19:52:28 +0000 @@ -1,3 +1,8 @@ +2012-11-08 Jan Djärv <jan.h.d@swipnet.se> + + * image.c (xpm_make_color_table_h): Fix compiler error because + make_hash_table changed. + 2012-11-08 Thomas Kappler <tkappler@gmail.com> (tiny change) * nsfont.m (ns_findfonts): Handle empty matchingDescs (Bug#11541). === modified file 'src/image.c' --- src/image.c 2012-10-14 23:25:37 +0000 +++ src/image.c 2012-11-08 19:52:28 +0000 @@ -3731,10 +3731,10 @@ { *put_func = xpm_put_color_table_h; *get_func = xpm_get_color_table_h; - return make_hash_table (Qequal, make_number (DEFAULT_HASH_SIZE), + return make_hash_table (hashtest_eql, make_number (DEFAULT_HASH_SIZE), make_float (DEFAULT_REHASH_SIZE), make_float (DEFAULT_REHASH_THRESHOLD), - Qnil, Qnil, Qnil); + Qnil); } static void ------------------------------------------------------------ revno: 110843 committer: Jan D. <jan.h.d@swipnet.se> branch nick: trunk timestamp: Thu 2012-11-08 20:51:07 +0100 message: nsfont.m (ns_findfonts): Handle empty matchingDescs (Bug#11541). diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-11-08 19:12:23 +0000 +++ src/ChangeLog 2012-11-08 19:51:07 +0000 @@ -1,3 +1,7 @@ +2012-11-08 Thomas Kappler <tkappler@gmail.com> (tiny change) + + * nsfont.m (ns_findfonts): Handle empty matchingDescs (Bug#11541). + 2012-11-08 Stefan Monnier <monnier@iro.umontreal.ca> Use ad-hoc comparison function for the profiler's hash-tables. === modified file 'src/nsfont.m' --- src/nsfont.m 2012-10-21 18:48:11 +0000 +++ src/nsfont.m 2012-11-08 19:51:07 +0000 @@ -559,7 +559,11 @@ if (isMatch) [fkeys removeObject: NSFontFamilyAttribute]; - matchingDescs = [fdesc matchingFontDescriptorsWithMandatoryKeys: fkeys]; + if ([fkeys count] > 0) + matchingDescs = [fdesc matchingFontDescriptorsWithMandatoryKeys: fkeys]; + else + matchingDescs = [NSMutableArray array]; + if (NSFONT_TRACE) NSLog(@"Got desc %@ and found %d matching fonts from it: ", fdesc, [matchingDescs count]); ------------------------------------------------------------ revno: 110842 committer: Stefan Monnier <monnier@iro.umontreal.ca> branch nick: trunk timestamp: Thu 2012-11-08 14:50:08 -0500 message: * lisp/files.el (hack-one-local-variable--obsolete): New function. (hack-one-local-variable): Use it for obsolete settings. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-11-08 19:45:58 +0000 +++ lisp/ChangeLog 2012-11-08 19:50:08 +0000 @@ -1,5 +1,8 @@ 2012-11-08 Stefan Monnier <monnier@iro.umontreal.ca> + * files.el (hack-one-local-variable--obsolete): New function. + (hack-one-local-variable): Use it for obsolete settings. + * subr.el (locate-user-emacs-file): If both old and new name exist, use the new name. === modified file 'lisp/files.el' --- lisp/files.el 2012-10-29 13:28:41 +0000 +++ lisp/files.el 2012-11-08 19:50:08 +0000 @@ -3387,30 +3387,39 @@ (setq ok t))) ok)))))))) +(defun hack-one-local-variable--obsolete (var) + (let ((o (get var 'byte-obsolete-variable))) + (when o + (let ((instead (nth 0 o)) + (since (nth 2 o))) + (message "%s is obsolete%s; %s" + var (if since (format " (since %s)" since)) + (if (stringp instead) instead + (format "use `%s' instead" instead))))))) + (defun hack-one-local-variable (var val) "Set local variable VAR with value VAL. If VAR is `mode', call `VAL-mode' as a function unless it's already the major mode." - (cond ((eq var 'mode) - (let ((mode (intern (concat (downcase (symbol-name val)) - "-mode")))) - (unless (eq (indirect-function mode) - (indirect-function major-mode)) - (if (memq mode minor-mode-list) - ;; A minor mode must be passed an argument. - ;; Otherwise, if the user enables the minor mode in a - ;; major mode hook, this would toggle it off. - (funcall mode 1) - (funcall mode))))) - ((eq var 'eval) - (save-excursion (eval val))) - (t - ;; Make sure the string has no text properties. - ;; Some text properties can get evaluated in various ways, - ;; so it is risky to put them on with a local variable list. - (if (stringp val) - (set-text-properties 0 (length val) nil val)) - (set (make-local-variable var) val)))) + (pcase var + (`mode + (let ((mode (intern (concat (downcase (symbol-name val)) + "-mode")))) + (unless (eq (indirect-function mode) + (indirect-function major-mode)) + (funcall mode)))) + (`eval + (pcase val + (`(add-hook ',hook . ,_) (hack-one-local-variable--obsolete hook))) + (save-excursion (eval val))) + (_ + (hack-one-local-variable--obsolete var) + ;; Make sure the string has no text properties. + ;; Some text properties can get evaluated in various ways, + ;; so it is risky to put them on with a local variable list. + (if (stringp val) + (set-text-properties 0 (length val) nil val)) + (set (make-local-variable var) val)))) ;;; Handling directory-local variables, aka project settings. ------------------------------------------------------------ revno: 110841 committer: Stefan Monnier <monnier@iro.umontreal.ca> branch nick: trunk timestamp: Thu 2012-11-08 14:45:58 -0500 message: * lisp/subr.el (locate-user-emacs-file): If both old and new name exist, use the new name. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-11-08 19:44:52 +0000 +++ lisp/ChangeLog 2012-11-08 19:45:58 +0000 @@ -1,5 +1,8 @@ 2012-11-08 Stefan Monnier <monnier@iro.umontreal.ca> + * subr.el (locate-user-emacs-file): If both old and new name exist, use + the new name. + * progmodes/js.el (js--filling-paragraph): New var. (c-forward-sws, c-backward-sws, c-beginning-of-macro): Advise. (js-c-fill-paragraph): Prefer advice to cl-letf so the rebinding is === modified file 'lisp/subr.el' --- lisp/subr.el 2012-10-27 05:03:52 +0000 +++ lisp/subr.el 2012-11-08 19:45:58 +0000 @@ -2657,13 +2657,17 @@ (defun locate-user-emacs-file (new-name &optional old-name) "Return an absolute per-user Emacs-specific file name. -If OLD-NAME is non-nil and ~/OLD-NAME exists, return ~/OLD-NAME. +If NEW-NAME exists in `user-emacs-directory', return it. +Else If OLD-NAME is non-nil and ~/OLD-NAME exists, return ~/OLD-NAME. Else return NEW-NAME in `user-emacs-directory', creating the directory if it does not exist." (convert-standard-filename (let* ((home (concat "~" (or init-file-user ""))) - (at-home (and old-name (expand-file-name old-name home)))) - (if (and at-home (file-readable-p at-home)) + (at-home (and old-name (expand-file-name old-name home))) + (bestname (abbreviate-file-name + (expand-file-name new-name user-emacs-directory)))) + (if (and at-home (not (file-readable-p bestname)) + (file-readable-p at-home)) at-home ;; Make sure `user-emacs-directory' exists, ;; unless we're in batch mode or dumping Emacs @@ -2677,8 +2681,7 @@ (set-default-file-modes ?\700) (make-directory user-emacs-directory)) (set-default-file-modes umask)))) - (abbreviate-file-name - (expand-file-name new-name user-emacs-directory)))))) + bestname)))) ;;;; Misc. useful functions. ------------------------------------------------------------ revno: 110840 committer: Stefan Monnier <monnier@iro.umontreal.ca> branch nick: trunk timestamp: Thu 2012-11-08 14:44:52 -0500 message: * lisp/progmodes/js.el: Prefer advice to cl-letf's sneaky rebinding. (c-forward-sws, c-backward-sws, c-beginning-of-macro): Advise. (js--filling-paragraph): New var. (js-c-fill-paragraph): Bind it instead of letf-ing the functions. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-11-08 16:37:34 +0000 +++ lisp/ChangeLog 2012-11-08 19:44:52 +0000 @@ -1,3 +1,10 @@ +2012-11-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/js.el (js--filling-paragraph): New var. + (c-forward-sws, c-backward-sws, c-beginning-of-macro): Advise. + (js-c-fill-paragraph): Prefer advice to cl-letf so the rebinding is + less sneaky. + 2012-11-08 Julien Danjou <julien@danjou.info> * progmodes/ruby-mode.el (auto-mode-alist): Add Rakefile in === modified file 'lisp/progmodes/js.el' --- lisp/progmodes/js.el 2012-08-22 05:35:38 +0000 +++ lisp/progmodes/js.el 2012-11-08 19:44:52 +0000 @@ -1823,22 +1823,31 @@ ;;; Filling +(defvar js--filling-paragraph nil) + +;; FIXME: Such redefinitions are bad style. We should try and use some other +;; way to get the same result. +(defadvice c-forward-sws (around js-fill-paragraph activate) + (if js--filling-paragraph + (setq ad-return-value (js--forward-syntactic-ws (ad-get-arg 0))) + ad-do-it)) + +(defadvice c-backward-sws (around js-fill-paragraph activate) + (if js--filling-paragraph + (setq ad-return-value (js--backward-syntactic-ws (ad-get-arg 0))) + ad-do-it)) + +(defadvice c-beginning-of-macro (around js-fill-paragraph activate) + (if js--filling-paragraph + (setq ad-return-value (js--beginning-of-macro (ad-get-arg 0))) + ad-do-it)) + (defun js-c-fill-paragraph (&optional justify) "Fill the paragraph with `c-fill-paragraph'." (interactive "*P") - ;; FIXME: Such redefinitions are bad style. We should try and use some other - ;; way to get the same result. - (cl-letf (((symbol-function 'c-forward-sws) - (lambda (&optional limit) - (js--forward-syntactic-ws limit))) - ((symbol-function 'c-backward-sws) - (lambda (&optional limit) - (js--backward-syntactic-ws limit))) - ((symbol-function 'c-beginning-of-macro) - (lambda (&optional limit) - (js--beginning-of-macro limit)))) - (let ((fill-paragraph-function 'c-fill-paragraph)) - (c-fill-paragraph justify)))) + (let ((js--filling-paragraph t) + (fill-paragraph-function 'c-fill-paragraph)) + (c-fill-paragraph justify))) ;;; Type database and Imenu ------------------------------------------------------------ revno: 110839 committer: Stefan Monnier <monnier@iro.umontreal.ca> branch nick: trunk timestamp: Thu 2012-11-08 14:12:23 -0500 message: Use ad-hoc comparison function for the profiler's hash-tables. * src/profiler.c (Qprofiler_backtrace_equal, hashtest_profiler): New vars. (make_log): Use them. (handle_profiler_signal): Don't inhibit quit any longer since we don't call Fequal any more. (Ffunction_equal): New function. (cmpfn_profiler, hashfn_profiler): New functions. (syms_of_profiler): Initialize them. * src/lisp.h (struct hash_table_test): New struct. (struct Lisp_Hash_Table): Use it. * src/alloc.c (mark_object): Mark hash_table_test fields of hash tables. * src/fns.c (make_hash_table): Take a struct to describe the test. (cmpfn_eql, cmpfn_equal, cmpfn_user_defined, hashfn_eq, hashfn_eql) (hashfn_equal, hashfn_user_defined): Adjust to new calling convention. (hash_lookup, hash_remove_from_table): Move assertion checking of hashfn result here. Check hash-equality before calling cmpfn. (Fmake_hash_table): Adjust call to make_hash_table. (hashtest_eq, hashtest_eql, hashtest_equal): New structs. (syms_of_fns): Initialize them. * src/emacs.c (main): Move syms_of_fns earlier. * src/xterm.c (syms_of_xterm): * src/category.c (hash_get_category_set): Adjust call to make_hash_table. * src/print.c (print_object): Adjust to new hash-table struct. * src/composite.c (composition_gstring_put_cache): Adjust to new hashfn. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-11-08 17:02:56 +0000 +++ src/ChangeLog 2012-11-08 19:12:23 +0000 @@ -1,3 +1,30 @@ +2012-11-08 Stefan Monnier <monnier@iro.umontreal.ca> + + Use ad-hoc comparison function for the profiler's hash-tables. + * profiler.c (Qprofiler_backtrace_equal, hashtest_profiler): New vars. + (make_log): Use them. + (handle_profiler_signal): Don't inhibit quit any longer since we don't + call Fequal any more. + (Ffunction_equal): New function. + (cmpfn_profiler, hashfn_profiler): New functions. + (syms_of_profiler): Initialize them. + * lisp.h (struct hash_table_test): New struct. + (struct Lisp_Hash_Table): Use it. + * alloc.c (mark_object): Mark hash_table_test fields of hash tables. + * fns.c (make_hash_table): Take a struct to describe the test. + (cmpfn_eql, cmpfn_equal, cmpfn_user_defined, hashfn_eq, hashfn_eql) + (hashfn_equal, hashfn_user_defined): Adjust to new calling convention. + (hash_lookup, hash_remove_from_table): Move assertion checking of + hashfn result here. Check hash-equality before calling cmpfn. + (Fmake_hash_table): Adjust call to make_hash_table. + (hashtest_eq, hashtest_eql, hashtest_equal): New structs. + (syms_of_fns): Initialize them. + * emacs.c (main): Move syms_of_fns earlier. + * xterm.c (syms_of_xterm): + * category.c (hash_get_category_set): Adjust call to make_hash_table. + * print.c (print_object): Adjust to new hash-table struct. + * composite.c (composition_gstring_put_cache): Adjust to new hashfn. + 2012-11-08 Eli Zaretskii <eliz@gnu.org> * w32fns.c (modifier_set): Fix handling of Scroll Lock when the === modified file 'src/alloc.c' --- src/alloc.c 2012-11-08 14:10:28 +0000 +++ src/alloc.c 2012-11-08 19:12:23 +0000 @@ -5809,6 +5809,9 @@ struct Lisp_Hash_Table *h = (struct Lisp_Hash_Table *) ptr; mark_vectorlike (ptr); + mark_object (h->test.name); + mark_object (h->test.user_hash_function); + mark_object (h->test.user_cmp_function); /* If hash table is not weak, mark all keys and values. For weak tables, mark only the vector. */ if (NILP (h->weak)) === modified file 'src/category.c' --- src/category.c 2012-10-01 06:36:54 +0000 +++ src/category.c 2012-11-08 19:12:23 +0000 @@ -78,10 +78,10 @@ if (NILP (XCHAR_TABLE (table)->extras[1])) set_char_table_extras (table, 1, - make_hash_table (Qequal, make_number (DEFAULT_HASH_SIZE), + make_hash_table (hashtest_equal, make_number (DEFAULT_HASH_SIZE), make_float (DEFAULT_REHASH_SIZE), make_float (DEFAULT_REHASH_THRESHOLD), - Qnil, Qnil, Qnil)); + Qnil)); h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]); i = hash_lookup (h, category_set, &hash); if (i >= 0) === modified file 'src/composite.c' --- src/composite.c 2012-09-22 02:15:29 +0000 +++ src/composite.c 2012-11-08 19:12:23 +0000 @@ -676,7 +676,7 @@ ptrdiff_t i; header = LGSTRING_HEADER (gstring); - hash = h->hashfn (h, header); + hash = h->test.hashfn (&h->test, header); if (len < 0) { ptrdiff_t j, glyph_len = LGSTRING_GLYPH_LEN (gstring); @@ -1382,7 +1382,7 @@ } else { - /* automatic composition */ + /* Automatic composition. */ Lisp_Object gstring = composition_gstring_from_id (cmp_it->id); Lisp_Object glyph; ptrdiff_t from; === modified file 'src/emacs.c' --- src/emacs.c 2012-11-05 03:18:32 +0000 +++ src/emacs.c 2012-11-08 19:12:23 +0000 @@ -1154,6 +1154,7 @@ /* Called before syms_of_fileio, because it sets up Qerror_condition. */ syms_of_data (); + syms_of_fns (); /* Before syms_of_charset which uses hashtables. */ syms_of_fileio (); /* Before syms_of_coding to initialize Vgc_cons_threshold. */ syms_of_alloc (); @@ -1165,7 +1166,7 @@ init_window_once (); /* Init the window system. */ #ifdef HAVE_WINDOW_SYSTEM - init_fringe_once (); /* Swap bitmaps if necessary. */ + init_fringe_once (); /* Swap bitmaps if necessary. */ #endif /* HAVE_WINDOW_SYSTEM */ } @@ -1348,7 +1349,6 @@ syms_of_lread (); syms_of_print (); syms_of_eval (); - syms_of_fns (); syms_of_floatfns (); syms_of_buffer (); === modified file 'src/fns.c' --- src/fns.c 2012-11-08 14:10:28 +0000 +++ src/fns.c 2012-11-08 19:12:23 +0000 @@ -2014,7 +2014,7 @@ d1 = extract_float (o1); d2 = extract_float (o2); /* If d is a NaN, then d != d. Two NaNs should be `equal' even - though they are not =. */ + though they are not =. */ return d1 == d2 || (d1 != d1 && d2 != d2); } @@ -3424,14 +3424,16 @@ Low-level Functions ***********************************************************************/ +struct hash_table_test hashtest_eq, hashtest_eql, hashtest_equal; + /* Compare KEY1 which has hash code HASH1 and KEY2 with hash code HASH2 in hash table H using `eql'. Value is true if KEY1 and KEY2 are the same. */ static bool -cmpfn_eql (struct Lisp_Hash_Table *h, - Lisp_Object key1, EMACS_UINT hash1, - Lisp_Object key2, EMACS_UINT hash2) +cmpfn_eql (struct hash_table_test *ht, + Lisp_Object key1, + Lisp_Object key2) { return (FLOATP (key1) && FLOATP (key2) @@ -3444,11 +3446,11 @@ KEY2 are the same. */ static bool -cmpfn_equal (struct Lisp_Hash_Table *h, - Lisp_Object key1, EMACS_UINT hash1, - Lisp_Object key2, EMACS_UINT hash2) +cmpfn_equal (struct hash_table_test *ht, + Lisp_Object key1, + Lisp_Object key2) { - return hash1 == hash2 && !NILP (Fequal (key1, key2)); + return !NILP (Fequal (key1, key2)); } @@ -3457,21 +3459,16 @@ if KEY1 and KEY2 are the same. */ static bool -cmpfn_user_defined (struct Lisp_Hash_Table *h, - Lisp_Object key1, EMACS_UINT hash1, - Lisp_Object key2, EMACS_UINT hash2) +cmpfn_user_defined (struct hash_table_test *ht, + Lisp_Object key1, + Lisp_Object key2) { - if (hash1 == hash2) - { - Lisp_Object args[3]; + Lisp_Object args[3]; - args[0] = h->user_cmp_function; - args[1] = key1; - args[2] = key2; - return !NILP (Ffuncall (3, args)); - } - else - return 0; + args[0] = ht->user_cmp_function; + args[1] = key1; + args[2] = key2; + return !NILP (Ffuncall (3, args)); } @@ -3480,54 +3477,48 @@ in a Lisp integer. */ static EMACS_UINT -hashfn_eq (struct Lisp_Hash_Table *h, Lisp_Object key) +hashfn_eq (struct hash_table_test *ht, Lisp_Object key) { EMACS_UINT hash = XUINT (key) ^ XTYPE (key); - eassert ((hash & ~INTMASK) == 0); return hash; } - /* Value is a hash code for KEY for use in hash table H which uses `eql' to compare keys. The hash code returned is guaranteed to fit in a Lisp integer. */ static EMACS_UINT -hashfn_eql (struct Lisp_Hash_Table *h, Lisp_Object key) +hashfn_eql (struct hash_table_test *ht, Lisp_Object key) { EMACS_UINT hash; if (FLOATP (key)) hash = sxhash (key, 0); else hash = XUINT (key) ^ XTYPE (key); - eassert ((hash & ~INTMASK) == 0); return hash; } - /* Value is a hash code for KEY for use in hash table H which uses `equal' to compare keys. The hash code returned is guaranteed to fit in a Lisp integer. */ static EMACS_UINT -hashfn_equal (struct Lisp_Hash_Table *h, Lisp_Object key) +hashfn_equal (struct hash_table_test *ht, Lisp_Object key) { EMACS_UINT hash = sxhash (key, 0); - eassert ((hash & ~INTMASK) == 0); return hash; } - /* Value is a hash code for KEY for use in hash table H which uses as user-defined function to compare keys. The hash code returned is guaranteed to fit in a Lisp integer. */ static EMACS_UINT -hashfn_user_defined (struct Lisp_Hash_Table *h, Lisp_Object key) +hashfn_user_defined (struct hash_table_test *ht, Lisp_Object key) { Lisp_Object args[2], hash; - args[0] = h->user_hash_function; + args[0] = ht->user_hash_function; args[1] = key; hash = Ffuncall (2, args); if (!INTEGERP (hash)) @@ -3563,9 +3554,9 @@ one of the symbols `key', `value', `key-or-value', or `key-and-value'. */ Lisp_Object -make_hash_table (Lisp_Object test, Lisp_Object size, Lisp_Object rehash_size, - Lisp_Object rehash_threshold, Lisp_Object weak, - Lisp_Object user_test, Lisp_Object user_hash) +make_hash_table (struct hash_table_test test, + Lisp_Object size, Lisp_Object rehash_size, + Lisp_Object rehash_threshold, Lisp_Object weak) { struct Lisp_Hash_Table *h; Lisp_Object table; @@ -3574,7 +3565,7 @@ double index_float; /* Preconditions. */ - eassert (SYMBOLP (test)); + eassert (SYMBOLP (test.name)); eassert (INTEGERP (size) && XINT (size) >= 0); eassert ((INTEGERP (rehash_size) && XINT (rehash_size) > 0) || (FLOATP (rehash_size) && 1 < XFLOAT_DATA (rehash_size))); @@ -3598,29 +3589,6 @@ /* Initialize hash table slots. */ h->test = test; - if (EQ (test, Qeql)) - { - h->cmpfn = cmpfn_eql; - h->hashfn = hashfn_eql; - } - else if (EQ (test, Qeq)) - { - h->cmpfn = NULL; - h->hashfn = hashfn_eq; - } - else if (EQ (test, Qequal)) - { - h->cmpfn = cmpfn_equal; - h->hashfn = hashfn_equal; - } - else - { - h->user_cmp_function = user_test; - h->user_hash_function = user_hash; - h->cmpfn = cmpfn_user_defined; - h->hashfn = hashfn_user_defined; - } - h->weak = weak; h->rehash_threshold = rehash_threshold; h->rehash_size = rehash_size; @@ -3776,7 +3744,8 @@ ptrdiff_t start_of_bucket; Lisp_Object idx; - hash_code = h->hashfn (h, key); + hash_code = h->test.hashfn (&h->test, key); + eassert ((hash_code & ~INTMASK) == 0); if (hash) *hash = hash_code; @@ -3788,9 +3757,9 @@ { ptrdiff_t i = XFASTINT (idx); if (EQ (key, HASH_KEY (h, i)) - || (h->cmpfn - && h->cmpfn (h, key, hash_code, - HASH_KEY (h, i), XUINT (HASH_HASH (h, i))))) + || (h->test.cmpfn + && hash_code == XUINT (HASH_HASH (h, i)) + && h->test.cmpfn (&h->test, key, HASH_KEY (h, i)))) break; idx = HASH_NEXT (h, i); } @@ -3841,7 +3810,8 @@ ptrdiff_t start_of_bucket; Lisp_Object idx, prev; - hash_code = h->hashfn (h, key); + hash_code = h->test.hashfn (&h->test, key); + eassert ((hash_code & ~INTMASK) == 0); start_of_bucket = hash_code % ASIZE (h->index); idx = HASH_INDEX (h, start_of_bucket); prev = Qnil; @@ -3852,9 +3822,9 @@ ptrdiff_t i = XFASTINT (idx); if (EQ (key, HASH_KEY (h, i)) - || (h->cmpfn - && h->cmpfn (h, key, hash_code, - HASH_KEY (h, i), XUINT (HASH_HASH (h, i))))) + || (h->test.cmpfn + && hash_code == XUINT (HASH_HASH (h, i)) + && h->test.cmpfn (&h->test, key, HASH_KEY (h, i)))) { /* Take entry out of collision chain. */ if (NILP (prev)) @@ -4303,7 +4273,7 @@ (ptrdiff_t nargs, Lisp_Object *args) { Lisp_Object test, size, rehash_size, rehash_threshold, weak; - Lisp_Object user_test, user_hash; + struct hash_table_test testdesc; char *used; ptrdiff_t i; @@ -4315,7 +4285,13 @@ /* See if there's a `:test TEST' among the arguments. */ i = get_key_arg (QCtest, nargs, args, used); test = i ? args[i] : Qeql; - if (!EQ (test, Qeq) && !EQ (test, Qeql) && !EQ (test, Qequal)) + if (EQ (test, Qeq)) + testdesc = hashtest_eq; + else if (EQ (test, Qeql)) + testdesc = hashtest_eql; + else if (EQ (test, Qequal)) + testdesc = hashtest_equal; + else { /* See if it is a user-defined test. */ Lisp_Object prop; @@ -4323,11 +4299,12 @@ prop = Fget (test, Qhash_table_test); if (!CONSP (prop) || !CONSP (XCDR (prop))) signal_error ("Invalid hash table test", test); - user_test = XCAR (prop); - user_hash = XCAR (XCDR (prop)); + testdesc.name = test; + testdesc.user_cmp_function = XCAR (prop); + testdesc.user_hash_function = XCAR (XCDR (prop)); + testdesc.hashfn = hashfn_user_defined; + testdesc.cmpfn = cmpfn_user_defined; } - else - user_test = user_hash = Qnil; /* See if there's a `:size SIZE' argument. */ i = get_key_arg (QCsize, nargs, args, used); @@ -4369,8 +4346,7 @@ if (!used[i]) signal_error ("Invalid argument list", args[i]); - return make_hash_table (test, size, rehash_size, rehash_threshold, weak, - user_test, user_hash); + return make_hash_table (testdesc, size, rehash_size, rehash_threshold, weak); } @@ -4424,7 +4400,7 @@ doc: /* Return the test TABLE uses. */) (Lisp_Object table) { - return check_hash_table (table)->test; + return check_hash_table (table)->test.name; } @@ -4988,4 +4964,14 @@ defsubr (&Smd5); defsubr (&Ssecure_hash); defsubr (&Slocale_info); + + { + struct hash_table_test + eq = { Qeq, Qnil, Qnil, NULL, hashfn_eq }, + eql = { Qeql, Qnil, Qnil, cmpfn_eql, hashfn_eql }, + equal = { Qequal, Qnil, Qnil, cmpfn_equal, hashfn_equal }; + hashtest_eq = eq; + hashtest_eql = eql; + hashtest_equal = equal; + } } === modified file 'src/lisp.h' --- src/lisp.h 2012-11-08 14:10:28 +0000 +++ src/lisp.h 2012-11-08 19:12:23 +0000 @@ -1159,14 +1159,29 @@ /* The structure of a Lisp hash table. */ +struct hash_table_test +{ + /* Name of the function used to compare keys. */ + Lisp_Object name; + + /* User-supplied hash function, or nil. */ + Lisp_Object user_hash_function; + + /* User-supplied key comparison function, or nil. */ + Lisp_Object user_cmp_function; + + /* C function to compare two keys. */ + bool (*cmpfn) (struct hash_table_test *t, Lisp_Object, Lisp_Object); + + /* C function to compute hash code. */ + EMACS_UINT (*hashfn) (struct hash_table_test *t, Lisp_Object); +}; + struct Lisp_Hash_Table { /* This is for Lisp; the hash table code does not refer to it. */ struct vectorlike_header header; - /* Function used to compare keys. */ - Lisp_Object test; - /* Nil if table is non-weak. Otherwise a symbol describing the weakness of the table. */ Lisp_Object weak; @@ -1197,12 +1212,6 @@ hash table size to reduce collisions. */ Lisp_Object index; - /* User-supplied hash function, or nil. */ - Lisp_Object user_hash_function; - - /* User-supplied key comparison function, or nil. */ - Lisp_Object user_cmp_function; - /* Only the fields above are traced normally by the GC. The ones below `count' are special and are either ignored by the GC or traced in a special way (e.g. because of weakness). */ @@ -1215,17 +1224,12 @@ This is gc_marked specially if the table is weak. */ Lisp_Object key_and_value; + /* The comparison and hash functions. */ + struct hash_table_test test; + /* Next weak hash table if this is a weak hash table. The head of the list is in weak_hash_tables. */ struct Lisp_Hash_Table *next_weak; - - /* C function to compare two keys. */ - bool (*cmpfn) (struct Lisp_Hash_Table *, - Lisp_Object, EMACS_UINT, - Lisp_Object, EMACS_UINT); - - /* C function to compute hash code. */ - EMACS_UINT (*hashfn) (struct Lisp_Hash_Table *, Lisp_Object); }; @@ -2707,12 +2711,12 @@ extern Lisp_Object QCsize, QCtest, QCweakness, Qequal, Qeq, Qeql; EMACS_UINT hash_string (char const *, ptrdiff_t); EMACS_UINT sxhash (Lisp_Object, int); -Lisp_Object make_hash_table (Lisp_Object, Lisp_Object, Lisp_Object, - Lisp_Object, Lisp_Object, Lisp_Object, - Lisp_Object); +Lisp_Object make_hash_table (struct hash_table_test, Lisp_Object, Lisp_Object, + Lisp_Object, Lisp_Object); ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *); ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object, EMACS_UINT); +extern struct hash_table_test hashtest_eq, hashtest_eql, hashtest_equal; extern Lisp_Object substring_both (Lisp_Object, ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t); === modified file 'src/print.c' --- src/print.c 2012-10-16 07:56:44 +0000 +++ src/print.c 2012-11-08 19:12:23 +0000 @@ -1815,14 +1815,14 @@ #endif /* Implement a readable output, e.g.: #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */ - /* Always print the size. */ + /* Always print the size. */ len = sprintf (buf, "#s(hash-table size %"pD"d", ASIZE (h->next)); strout (buf, len, len, printcharfun); - if (!NILP (h->test)) + if (!NILP (h->test.name)) { strout (" test ", -1, -1, printcharfun); - print_object (h->test, printcharfun, escapeflag); + print_object (h->test.name, printcharfun, escapeflag); } if (!NILP (h->weak)) === modified file 'src/profiler.c' --- src/profiler.c 2012-10-04 05:52:49 +0000 +++ src/profiler.c 2012-11-08 19:12:23 +0000 @@ -35,6 +35,9 @@ typedef struct Lisp_Hash_Table log_t; +static Lisp_Object Qprofiler_backtrace_equal; +static struct hash_table_test hashtest_profiler; + static Lisp_Object make_log (int heap_size, int max_stack_depth) { @@ -42,10 +45,11 @@ a special way. This is OK as long as the object is not exposed to Elisp, i.e. until it is returned by *-profiler-log, after which it can't be used any more. */ - Lisp_Object log = make_hash_table (Qequal, make_number (heap_size), + Lisp_Object log = make_hash_table (hashtest_profiler, + make_number (heap_size), make_float (DEFAULT_REHASH_SIZE), make_float (DEFAULT_REHASH_THRESHOLD), - Qnil, Qnil, Qnil); + Qnil); struct Lisp_Hash_Table *h = XHASH_TABLE (log); /* What is special about our hash-tables is that the keys are pre-filled @@ -238,8 +242,6 @@ cpu_gc_count = saturated_add (cpu_gc_count, 1); else { - Lisp_Object oquit; - bool saved_pending_signals; EMACS_INT count = 1; #ifdef HAVE_ITIMERSPEC if (profiler_timer_ok) @@ -249,19 +251,8 @@ count += overruns; } #endif - /* record_backtrace uses hash functions that call Fequal, which - uses QUIT, which can call malloc, which can cause disaster in - a signal handler. So inhibit QUIT. */ - oquit = Vinhibit_quit; - saved_pending_signals = pending_signals; - Vinhibit_quit = Qt; - pending_signals = 0; - eassert (HASH_TABLE_P (cpu_log)); record_backtrace (XHASH_TABLE (cpu_log), count); - - Vinhibit_quit = oquit; - pending_signals = saved_pending_signals; } } @@ -515,6 +506,66 @@ record_backtrace (XHASH_TABLE (memory_log), min (size, MOST_POSITIVE_FIXNUM)); } +DEFUN ("function-equal", Ffunction_equal, Sfunction_equal, 2, 2, 0, + doc: /* Return non-nil if F1 and F2 come from the same source. +Used to determine if different closures are just different instances of +the same lambda expression, or are really unrelated function. */) + (Lisp_Object f1, Lisp_Object f2) +{ + bool res; + if (EQ (f1, f2)) + res = true; + else if (COMPILEDP (f1) && COMPILEDP (f2)) + res = EQ (AREF (f1, COMPILED_BYTECODE), AREF (f2, COMPILED_BYTECODE)); + else if (CONSP (f1) && CONSP (f2) && CONSP (XCDR (f1)) && CONSP (XCDR (f2)) + && EQ (Qclosure, XCAR (f1)) + && EQ (Qclosure, XCAR (f2))) + res = EQ (XCDR (XCDR (f1)), XCDR (XCDR (f2))); + else + res = false; + return res ? Qt : Qnil; +} + +static bool +cmpfn_profiler (struct hash_table_test *t, + Lisp_Object bt1, Lisp_Object bt2) +{ + if (VECTORP (bt1) && VECTORP (bt2)) + { + ptrdiff_t i, l = ASIZE (bt1); + if (l != ASIZE (bt2)) + return false; + for (i = 0; i < l; i++) + if (NILP (Ffunction_equal (AREF (bt1, i), AREF (bt2, i)))) + return false; + return true; + } + else + return EQ (bt1, bt2); +} + +static EMACS_UINT +hashfn_profiler (struct hash_table_test *ht, Lisp_Object bt) +{ + if (VECTORP (bt)) + { + EMACS_UINT hash = 0; + ptrdiff_t i, l = ASIZE (bt); + for (i = 0; i < l; i++) + { + Lisp_Object f = AREF (bt, i); + EMACS_UINT hash1 + = (COMPILEDP (f) ? XUINT (AREF (f, COMPILED_BYTECODE)) + : (CONSP (f) && CONSP (XCDR (f)) && EQ (Qclosure, XCAR (f))) + ? XUINT (XCDR (XCDR (f))) : XUINT (f)); + hash = hash1 + (hash << 1) + (hash == (EMACS_INT) hash); + } + return (hash & INTMASK); + } + else + return XUINT (bt); +} + void syms_of_profiler (void) { @@ -527,6 +578,16 @@ to make room for new entries. */); profiler_log_size = 10000; + DEFSYM (Qprofiler_backtrace_equal, "profiler-backtrace-equal"); + { + struct hash_table_test test + = { Qprofiler_backtrace_equal, Qnil, Qnil, + cmpfn_profiler, hashfn_profiler }; + hashtest_profiler = test; + } + + defsubr (&Sfunction_equal); + #ifdef PROFILER_CPU_SUPPORT profiler_cpu_running = NOT_RUNNING; cpu_log = Qnil; === modified file 'src/regex.c' --- src/regex.c 2012-10-10 19:53:26 +0000 +++ src/regex.c 2012-11-08 19:12:23 +0000 @@ -28,7 +28,7 @@ rather than at run-time, so that re_match can be reentrant. */ -/* AIX requires this to be the first thing in the file. */ +/* AIX requires this to be the first thing in the file. */ #if defined _AIX && !defined REGEX_MALLOC #pragma alloca #endif === modified file 'src/xterm.c' --- src/xterm.c 2012-11-02 09:44:08 +0000 +++ src/xterm.c 2012-11-08 19:12:23 +0000 @@ -10868,10 +10868,10 @@ DEFVAR_LISP ("x-keysym-table", Vx_keysym_table, doc: /* Hash table of character codes indexed by X keysym codes. */); - Vx_keysym_table = make_hash_table (Qeql, make_number (900), + Vx_keysym_table = make_hash_table (hashtest_eql, make_number (900), make_float (DEFAULT_REHASH_SIZE), make_float (DEFAULT_REHASH_THRESHOLD), - Qnil, Qnil, Qnil); + Qnil); } #endif /* HAVE_X_WINDOWS */ ------------------------------------------------------------ revno: 110838 fixes bug: http://debbugs.gnu.org/12806 committer: Eli Zaretskii <eliz@gnu.org> branch nick: trunk timestamp: Thu 2012-11-08 19:02:56 +0200 message: More fixes for bug #12806. src/w32fns.c (modifier_set): Fix handling of Scroll Lock when the value of w32-scroll-lock-modifier is neither nil nor one of the known key modifiers. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-11-08 14:10:28 +0000 +++ src/ChangeLog 2012-11-08 17:02:56 +0000 @@ -1,3 +1,9 @@ +2012-11-08 Eli Zaretskii <eliz@gnu.org> + + * w32fns.c (modifier_set): Fix handling of Scroll Lock when the + value of w32-scroll-lock-modifier is neither nil nor one of the + known key modifiers. (Bug#12806) + 2012-11-08 Dmitry Antipov <dmantipov@yandex.ru> Shrink struct vectorlike_header to the only size field. === modified file 'src/w32fns.c' --- src/w32fns.c 2012-11-07 21:48:18 +0000 +++ src/w32fns.c 2012-11-08 17:02:56 +0000 @@ -2085,6 +2085,12 @@ static int modifier_set (int vkey) { + /* Warning: The fact that VK_NUMLOCK is not treated as the other 2 + toggle keys is not an omission! If you want to add it, you will + have to make changes in the default sub-case of the WM_KEYDOWN + switch, because if the NUMLOCK modifier is set, the code there + will directly convert any key that looks like an ASCII letter, + and also downcase those that look like upper-case ASCII. */ if (vkey == VK_CAPITAL) { if (NILP (Vw32_enable_caps_lock)) @@ -2094,7 +2100,15 @@ } if (vkey == VK_SCROLL) { - if (NILP (Vw32_scroll_lock_modifier)) + if (NILP (Vw32_scroll_lock_modifier) + /* w32-scroll-lock-modifier can be any non-nil value that is + not one of the modifiers, in which case it shall be ignored. */ + || !( EQ (Vw32_scroll_lock_modifier, Qhyper) + || EQ (Vw32_scroll_lock_modifier, Qsuper) + || EQ (Vw32_scroll_lock_modifier, Qmeta) + || EQ (Vw32_scroll_lock_modifier, Qalt) + || EQ (Vw32_scroll_lock_modifier, Qcontrol) + || EQ (Vw32_scroll_lock_modifier, Qshift))) return 0; else return (GetKeyState (vkey) & 0x1); ------------------------------------------------------------ revno: 110837 fixes bug: http://debbugs.gnu.org/12835 committer: Julien Danjou <julien@danjou.info> branch nick: trunk timestamp: Thu 2012-11-08 17:37:34 +0100 message: Add Rakefile in auto-mode-list for ruby-mode * progmodes/ruby-mode.el (auto-mode-alist): Add Rakefile in `auto-mode-alist' (Bug#12835). diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-11-08 15:35:32 +0000 +++ lisp/ChangeLog 2012-11-08 16:37:34 +0000 @@ -1,3 +1,8 @@ +2012-11-08 Julien Danjou <julien@danjou.info> + + * progmodes/ruby-mode.el (auto-mode-alist): Add Rakefile in + `auto-mode-alist' (Bug#12835). + 2012-11-08 Stefan Monnier <monnier@iro.umontreal.ca> * progmodes/perl-mode.el (perl-prettify-symbols): New defcustom. === modified file 'lisp/progmodes/ruby-mode.el' --- lisp/progmodes/ruby-mode.el 2012-09-24 11:39:33 +0000 +++ lisp/progmodes/ruby-mode.el 2012-11-08 16:37:34 +0000 @@ -1638,6 +1638,8 @@ ;;;###autoload (add-to-list 'auto-mode-alist (cons (purecopy "\\.rb\\'") 'ruby-mode)) +;;;###autoload +(add-to-list 'auto-mode-alist '("Rakefile\\'" . ruby-mode)) ;;;###autoload (dolist (name (list "ruby" "rbx" "jruby" "ruby1.9" "ruby1.8")) ------------------------------------------------------------ revno: 110836 committer: Stefan Monnier <monnier@iro.umontreal.ca> branch nick: trunk timestamp: Thu 2012-11-08 10:37:29 -0500 message: * perl-mode.el: Add coding cookie. diff: === modified file 'lisp/progmodes/perl-mode.el' --- lisp/progmodes/perl-mode.el 2012-11-08 15:35:32 +0000 +++ lisp/progmodes/perl-mode.el 2012-11-08 15:37:29 +0000 @@ -1,4 +1,4 @@ -;;; perl-mode.el --- Perl code editing commands for GNU Emacs +;;; perl-mode.el --- Perl code editing commands for GNU Emacs -*- coding: utf-8 -*- ;; Copyright (C) 1990, 1994, 2001-2012 Free Software Foundation, Inc. @@ -102,11 +102,6 @@ ;;; Code: - -(defvar font-lock-comment-face) -(defvar font-lock-doc-face) -(defvar font-lock-string-face) - (defgroup perl nil "Major mode for editing Perl code." :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) @@ -227,24 +222,24 @@ perl-font-lock-keywords-1 `( ;; Fontify keywords, except those fontified otherwise. ,(concat "\\<" - (regexp-opt '("if" "until" "while" "elsif" "else" "unless" - "do" "dump" "for" "foreach" "exit" "die" - "BEGIN" "END" "return" "exec" "eval") t) - "\\>") - ;; - ;; Fontify local and my keywords as types. + (regexp-opt '("if" "until" "while" "elsif" "else" "unless" + "do" "dump" "for" "foreach" "exit" "die" + "BEGIN" "END" "return" "exec" "eval") t) + "\\>") + ;; + ;; Fontify local and my keywords as types. ("\\<\\(local\\|my\\)\\>" . font-lock-type-face) - ;; - ;; Fontify function, variable and file name references. + ;; + ;; Fontify function, variable and file name references. ("&\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-function-name-face) - ;; Additionally underline non-scalar variables. Maybe this is a bad idea. - ;;'("[$@%*][#{]?\\(\\sw+\\)" 1 font-lock-variable-name-face) + ;; Additionally underline non-scalar variables. Maybe this is a bad idea. + ;;'("[$@%*][#{]?\\(\\sw+\\)" 1 font-lock-variable-name-face) ("[$*]{?\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-variable-name-face) ("\\([@%]\\|\\$#\\)\\(\\sw+\\(::\\sw+\\)*\\)" (2 (cons font-lock-variable-name-face '(underline)))) ("<\\(\\sw+\\)>" 1 font-lock-constant-face) - ;; - ;; Fontify keywords with/and labels as we do in `c++-font-lock-keywords'. + ;; + ;; Fontify keywords with/and labels as we do in `c++-font-lock-keywords'. ("\\<\\(continue\\|goto\\|last\\|next\\|redo\\)\\>[ \t]*\\(\\sw+\\)?" (1 font-lock-keyword-face) (2 font-lock-constant-face nil t)) ("^[ \t]*\\(\\sw+\\)[ \t]*:[^:]" 1 font-lock-constant-face) ------------------------------------------------------------ revno: 110835 committer: Stefan Monnier <monnier@iro.umontreal.ca> branch nick: trunk timestamp: Thu 2012-11-08 10:35:32 -0500 message: * lisp/progmodes/perl-mode.el (perl-prettify-symbols): New defcustom. (perl--prettify-symbols-alist): New const. (perl--font-lock-compose-symbol, perl--font-lock-symbols-keywords): New funs. (perl-font-lock-keywords-2): Use them. (perl-electric-noindent-p): New function. (perl-mode): Use it to set up electric-indent-mode. (perl-electric-terminator, perl-indent-command): Mark obsolete. (perl-mode-map): Remove bindings for them. (perl-imenu-generic-expression, perl-outline-level): Match functions&packages in column>0. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-11-08 15:10:08 +0000 +++ lisp/ChangeLog 2012-11-08 15:35:32 +0000 @@ -1,5 +1,17 @@ 2012-11-08 Stefan Monnier <monnier@iro.umontreal.ca> + * progmodes/perl-mode.el (perl-prettify-symbols): New defcustom. + (perl--prettify-symbols-alist): New const. + (perl--font-lock-compose-symbol, perl--font-lock-symbols-keywords): + New functions. + (perl-font-lock-keywords-2): Use them. + (perl-electric-noindent-p): New function. + (perl-mode): Use it to set up electric-indent-mode. + (perl-electric-terminator, perl-indent-command): Mark obsolete. + (perl-mode-map): Remove bindings for them. + (perl-imenu-generic-expression, perl-outline-level): + Match functions&packages in column>0. + * env.el (env--substitute-vars-regexp): New const. (substitute-env-vars): Use it. Add `only-defined' arg. * net/tramp.el (tramp-replace-environment-variables): Use it. === modified file 'lisp/progmodes/perl-mode.el' --- lisp/progmodes/perl-mode.el 2012-09-17 05:41:04 +0000 +++ lisp/progmodes/perl-mode.el 2012-11-08 15:35:32 +0000 @@ -119,16 +119,11 @@ (defvar perl-mode-map (let ((map (make-sparse-keymap))) - (define-key map "{" 'perl-electric-terminator) - (define-key map "}" 'perl-electric-terminator) - (define-key map ";" 'perl-electric-terminator) - (define-key map ":" 'perl-electric-terminator) (define-key map "\e\C-a" 'perl-beginning-of-function) (define-key map "\e\C-e" 'perl-end-of-function) (define-key map "\e\C-h" 'perl-mark-function) (define-key map "\e\C-q" 'perl-indent-exp) (define-key map "\177" 'backward-delete-char-untabify) - (define-key map "\t" 'perl-indent-command) map) "Keymap used in Perl mode.") @@ -158,16 +153,54 @@ (defvar perl-imenu-generic-expression '(;; Functions - (nil "^sub\\s-+\\([-A-Za-z0-9+_:]+\\)" 1) + (nil "^[ \t]*sub\\s-+\\([-A-Za-z0-9+_:]+\\)" 1) ;;Variables ("Variables" "^\\(?:my\\|our\\)\\s-+\\([$@%][-A-Za-z0-9+_:]+\\)\\s-*=" 1) - ("Packages" "^package\\s-+\\([-A-Za-z0-9+_:]+\\);" 1) + ("Packages" "^[ \t]*package\\s-+\\([-A-Za-z0-9+_:]+\\);" 1) ("Doc sections" "^=head[0-9][ \t]+\\(.*\\)" 1)) "Imenu generic expression for Perl mode. See `imenu-generic-expression'.") ;; Regexps updated with help from Tom Tromey <tromey@cambric.colorado.edu> and ;; Jim Campbell <jec@murzim.ca.boeing.com>. +(defcustom perl-prettify-symbols t + "If non-nil, some symbols will be displayed using Unicode chars." + :type 'boolean) + +(defconst perl--prettify-symbols-alist + '(;;("andalso" . ?∧) ("orelse" . ?∨) ("as" . ?≡)("not" . ?¬) + ;;("div" . ?÷) ("*" . ?×) ("o" . ?○) + ("->" . ?→) + ("=>" . ?⇒) + ;;("<-" . ?←) ("<>" . ?≠) (">=" . ?≥) ("<=" . ?≤) ("..." . ?⋯) + ("::" . ?∷) + )) + +(defun perl--font-lock-compose-symbol () + "Compose a sequence of ascii chars into a symbol. +Regexp match data 0 points to the chars." + ;; Check that the chars should really be composed into a symbol. + (let* ((start (match-beginning 0)) + (end (match-end 0)) + (syntaxes (if (eq (char-syntax (char-after start)) ?w) + '(?w) '(?. ?\\)))) + (if (or (memq (char-syntax (or (char-before start) ?\ )) syntaxes) + (memq (char-syntax (or (char-after end) ?\ )) syntaxes) + (nth 8 (syntax-ppss))) + ;; No composition for you. Let's actually remove any composition + ;; we may have added earlier and which is now incorrect. + (remove-text-properties start end '(composition)) + ;; That's a symbol alright, so add the composition. + (compose-region start end (cdr (assoc (match-string 0) + perl--prettify-symbols-alist))))) + ;; Return nil because we're not adding any face property. + nil) + +(defun perl--font-lock-symbols-keywords () + (when perl-prettify-symbols + `((,(regexp-opt (mapcar 'car perl--prettify-symbols-alist) t) + (0 (perl--font-lock-compose-symbol)))))) + (defconst perl-font-lock-keywords-1 '(;; What is this for? ;;("\\(--- .* ---\\|=== .* ===\\)" . font-lock-string-face) @@ -190,32 +223,32 @@ "Subdued level highlighting for Perl mode.") (defconst perl-font-lock-keywords-2 - (append perl-font-lock-keywords-1 - (list - ;; - ;; Fontify keywords, except those fontified otherwise. - (concat "\\<" + (append + perl-font-lock-keywords-1 + `( ;; Fontify keywords, except those fontified otherwise. + ,(concat "\\<" (regexp-opt '("if" "until" "while" "elsif" "else" "unless" "do" "dump" "for" "foreach" "exit" "die" "BEGIN" "END" "return" "exec" "eval") t) "\\>") ;; ;; Fontify local and my keywords as types. - '("\\<\\(local\\|my\\)\\>" . font-lock-type-face) + ("\\<\\(local\\|my\\)\\>" . font-lock-type-face) ;; ;; Fontify function, variable and file name references. - '("&\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-function-name-face) + ("&\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-function-name-face) ;; Additionally underline non-scalar variables. Maybe this is a bad idea. ;;'("[$@%*][#{]?\\(\\sw+\\)" 1 font-lock-variable-name-face) - '("[$*]{?\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-variable-name-face) - '("\\([@%]\\|\\$#\\)\\(\\sw+\\(::\\sw+\\)*\\)" + ("[$*]{?\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-variable-name-face) + ("\\([@%]\\|\\$#\\)\\(\\sw+\\(::\\sw+\\)*\\)" (2 (cons font-lock-variable-name-face '(underline)))) - '("<\\(\\sw+\\)>" 1 font-lock-constant-face) + ("<\\(\\sw+\\)>" 1 font-lock-constant-face) ;; ;; Fontify keywords with/and labels as we do in `c++-font-lock-keywords'. - '("\\<\\(continue\\|goto\\|last\\|next\\|redo\\)\\>[ \t]*\\(\\sw+\\)?" + ("\\<\\(continue\\|goto\\|last\\|next\\|redo\\)\\>[ \t]*\\(\\sw+\\)?" (1 font-lock-keyword-face) (2 font-lock-constant-face nil t)) - '("^[ \t]*\\(\\sw+\\)[ \t]*:[^:]" 1 font-lock-constant-face))) + ("^[ \t]*\\(\\sw+\\)[ \t]*:[^:]" 1 font-lock-constant-face) + ,@(perl--font-lock-symbols-keywords))) "Gaudy level highlighting for Perl mode.") (defvar perl-font-lock-keywords perl-font-lock-keywords-1 @@ -543,8 +576,10 @@ (defun perl-outline-level () (cond - ((looking-at "package\\s-") 0) - ((looking-at "sub\\s-") 1) + ((looking-at "[ \t]*\\(package\\)\\s-") + (- (match-beginning 1) (match-beginning 0))) + ((looking-at "[ \t]*s\\(ub\\)\\s-") + (- (match-beginning 1) (match-beginning 0))) ((looking-at "=head[0-9]") (- (char-before (match-end 0)) ?0)) ((looking-at "=cut") 1) (t 3))) @@ -621,6 +656,11 @@ #'perl-syntax-propertize-function) (add-hook 'syntax-propertize-extend-region-functions #'syntax-propertize-multiline 'append 'local) + ;; Electricity. + ;; FIXME: setup electric-layout-rules. + (set (make-local-variable 'electric-indent-chars) + (append '(?\{ ?\} ?\; ?\:) electric-indent-chars)) + (add-hook 'electric-indent-functions #'perl-electric-noindent-p nil t) ;; Tell imenu how to handle Perl. (set (make-local-variable 'imenu-generic-expression) perl-imenu-generic-expression) @@ -637,7 +677,11 @@ 0 ;Existing comment at bol stays there. comment-column)) -(defalias 'electric-perl-terminator 'perl-electric-terminator) +(define-obsolete-function-alias 'electric-perl-terminator + 'perl-electric-terminator "22.1") +(defun perl-electric-noindent-p (char) + (unless (eolp) 'no-indent)) + (defun perl-electric-terminator (arg) "Insert character and maybe adjust indentation. If at end-of-line, and not in a comment or a quote, correct the indentation." @@ -661,6 +705,7 @@ (perl-indent-line) (delete-char -1)))) (self-insert-command (prefix-numeric-value arg))) +(make-obsolete 'perl-electric-terminator 'electric-indent-mode "24.4") ;; not used anymore, but may be useful someday: ;;(defun perl-inside-parens-p () @@ -744,6 +789,7 @@ (t (message "Use backslash to quote # characters.") (ding t))))))))) +(make-obsolete 'perl-indent-command 'indent-according-to-mode "24.4") (defun perl-indent-line (&optional nochange parse-start) "Indent current line as Perl code. ------------------------------------------------------------ revno: 110834 committer: Stefan Monnier <monnier@iro.umontreal.ca> branch nick: trunk timestamp: Thu 2012-11-08 10:10:08 -0500 message: * lisp/env.el (env--substitute-vars-regexp): New const. (substitute-env-vars): Use it. Add `only-defined' arg. * lisp/net/tramp.el (tramp-replace-environment-variables): Use it. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-11-08 14:21:21 +0000 +++ lisp/ChangeLog 2012-11-08 15:10:08 +0000 @@ -1,5 +1,9 @@ 2012-11-08 Stefan Monnier <monnier@iro.umontreal.ca> + * env.el (env--substitute-vars-regexp): New const. + (substitute-env-vars): Use it. Add `only-defined' arg. + * net/tramp.el (tramp-replace-environment-variables): Use it. + * emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment): Byte-compile *before* eval in eval-and-compile. (byte-compile-log-warning): Remove redundant inhibit-read-only. === modified file 'lisp/env.el' --- lisp/env.el 2012-06-22 21:24:54 +0000 +++ lisp/env.el 2012-11-08 15:10:08 +0000 @@ -57,31 +57,31 @@ ;; History list for VALUE argument to setenv. (defvar setenv-history nil) +(defconst env--substitute-vars-regexp + (rx "$" + (or (submatch-n 1 (1+ (regexp "[[:alnum:]_]"))) + (and "{" (submatch-n 1 (minimal-match (0+ anything))) "}") + "$"))) -(defun substitute-env-vars (string) +(defun substitute-env-vars (string &optional only-defined) "Substitute environment variables referred to in STRING. `$FOO' where FOO is an environment variable name means to substitute the value of that variable. The variable name should be terminated with a character not a letter, digit or underscore; otherwise, enclose the entire variable name in braces. For instance, in `ab$cd-x', `$cd' is treated as an environment variable. +If ONLY-DEFINED is nil, references to undefined environment variables +are replaced by the empty string; if it is non-nil, they are left unchanged. Use `$$' to insert a single dollar sign." (let ((start 0)) - (while (string-match - (eval-when-compile - (rx (or (and "$" (submatch (1+ (regexp "[[:alnum:]_]")))) - (and "${" (submatch (minimal-match (0+ anything))) "}") - "$$"))) - string start) + (while (string-match env--substitute-vars-regexp string start) (cond ((match-beginning 1) (let ((value (getenv (match-string 1 string)))) - (setq string (replace-match (or value "") t t string) - start (+ (match-beginning 0) (length value))))) - ((match-beginning 2) - (let ((value (getenv (match-string 2 string)))) - (setq string (replace-match (or value "") t t string) - start (+ (match-beginning 0) (length value))))) + (if (and (null value) only-defined) + (setq start (match-end 0)) + (setq string (replace-match (or value "") t t string) + start (+ (match-beginning 0) (length value)))))) (t (setq string (replace-match "$" t t string) start (+ (match-beginning 0) 1))))) @@ -185,7 +185,7 @@ the environment. Otherwise, value is a string. If optional parameter FRAME is non-nil, then it should be a -frame. This function will look up VARIABLE in its 'environment +frame. This function will look up VARIABLE in its `environment' parameter. Otherwise, this function searches `process-environment' for === modified file 'lisp/minibuffer.el' --- lisp/minibuffer.el 2012-10-28 19:07:52 +0000 +++ lisp/minibuffer.el 2012-11-08 15:10:08 +0000 @@ -51,6 +51,9 @@ ;;; Todo: +;; - Make *Completions* readable even if some of the completion +;; entries have LF chars or spaces in them (including at +;; beginning/end) or are very long. ;; - for M-x, cycle-sort commands that have no key binding first. ;; - Make things like icomplete-mode or lightning-completion work with ;; completion-in-region-mode. @@ -74,6 +77,9 @@ ;; - whether the user wants completion to pay attention to case. ;; e.g. we may want to make it possible for the user to say "first try ;; completion case-sensitively, and if that fails, try to ignore case". +;; Maybe the trick is that we should distinguish completion-ignore-case in +;; try/all-completions (obey user's preference) from its use in +;; test-completion (obey the underlying object's semantics). ;; - add support for ** to pcm. ;; - Add vc-file-name-completion-table to read-file-name-internal. @@ -2048,6 +2054,8 @@ process-environment)) (defconst completion--embedded-envvar-re + ;; We can't reuse env--substitute-vars-regexp because we need to match only + ;; potentially-unfinished envvars at end of string. (concat "\\(?:^\\|[^$]\\(?:\\$\\$\\)*\\)" "$\\([[:alnum:]_]*\\|{\\([^}]*\\)\\)\\'")) === modified file 'lisp/net/tramp.el' --- lisp/net/tramp.el 2012-10-09 12:49:02 +0000 +++ lisp/net/tramp.el 2012-11-08 15:10:08 +0000 @@ -1748,20 +1748,26 @@ (or (file-modes filename) (logand (default-file-modes) (tramp-compat-octal-to-decimal "0666")))) -(defun tramp-replace-environment-variables (filename) - "Replace environment variables in FILENAME. +(defalias 'tramp-replace-environment-variables + (if (ignore-errors + (equal "${ tramp?}" (substitute-env-vars "${ tramp?}" 'only-defined))) + (lambda (filename) + "Like `substitute-env-vars' with `only-defined' non-nil." + (substitute-env-vars filename 'only-defined)) + (lambda (filename) + "Replace environment variables in FILENAME. Return the string with the replaced variables." - (save-match-data - (let ((idx (string-match "$\\(\\w+\\)" filename))) - ;; `$' is coded as `$$'. - (when (and idx - (or (zerop idx) (not (eq ?$ (aref filename (1- idx))))) - (getenv (match-string 1 filename))) - (setq filename - (replace-match - (substitute-in-file-name (match-string 0 filename)) - t nil filename))) - filename))) + (save-match-data + (let ((idx (string-match "$\\(\\w+\\)" filename))) + ;; `$' is coded as `$$'. + (when (and idx + (or (zerop idx) (not (eq ?$ (aref filename (1- idx))))) + (getenv (match-string 1 filename))) + (setq filename + (replace-match + (substitute-in-file-name (match-string 0 filename)) + t nil filename))) + filename))))) ;; In XEmacs, electricity is implemented via a key map for ?/ and ?~, ;; which calls corresponding functions (see minibuf.el). ------------------------------------------------------------ revno: 110833 committer: Stefan Monnier <monnier@iro.umontreal.ca> branch nick: trunk timestamp: Thu 2012-11-08 09:58:15 -0500 message: * lisp/emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment): Byte-compile *before* eval in eval-and-compile. (byte-compile-log-warning): Remove redundant inhibit-read-only. (byte-compile-file-form-autoload): Don't hide actual definition. (byte-compile-maybe-guarded): Accept `functionp' as well. diff: === modified file 'lisp/emacs-lisp/bytecomp.el' --- lisp/emacs-lisp/bytecomp.el 2012-11-02 22:35:01 +0000 +++ lisp/emacs-lisp/bytecomp.el 2012-11-08 14:58:15 +0000 @@ -419,8 +419,8 @@ (defconst byte-compile-initial-macro-environment '( -;; (byte-compiler-options . (lambda (&rest forms) -;; (apply 'byte-compiler-options-handler forms))) + ;; (byte-compiler-options . (lambda (&rest forms) + ;; (apply 'byte-compiler-options-handler forms))) (declare-function . byte-compile-macroexpand-declare-function) (eval-when-compile . (lambda (&rest body) (list @@ -429,8 +429,19 @@ (byte-compile-top-level (byte-compile-preprocess (cons 'progn body))))))) (eval-and-compile . (lambda (&rest body) - (byte-compile-eval-before-compile (cons 'progn body)) - (cons 'progn body)))) + ;; Byte compile before running it. Do it piece by + ;; piece, in case further expressions need earlier + ;; ones to be evaluated already, as is the case in + ;; eieio.el. + `(progn + ,@(mapcar (lambda (exp) + (let ((cexp + (byte-compile-top-level + (byte-compile-preprocess + exp)))) + (eval cexp) + cexp)) + body))))) "The default macro-environment passed to macroexpand by the compiler. Placing a macro here will cause a macro to have different semantics when expanded by the compiler as when expanded by the interpreter.") @@ -731,9 +742,11 @@ ;; Also, this lets us notice references to free variables. (defmacro byte-compile-push-bytecodes (&rest args) - "Push BYTE... onto BYTES, and increment PC by the number of bytes pushed. -ARGS is of the form (BYTE... BYTES PC), where BYTES and PC are variable names. -BYTES and PC are updated after evaluating all the arguments." + "Push bytes onto BVAR, and increment CVAR by the number of bytes pushed. +BVAR and CVAR are variables which are updated after evaluating +all the arguments. + +\(fn BYTE1 BYTE2 ... BYTEn BVAR CVAR)" (let ((byte-exprs (butlast args 2)) (bytes-var (car (last args 2))) (pc-var (car (last args)))) @@ -1097,8 +1110,7 @@ (defun byte-compile-log-warning (string &optional fill level) (let ((warning-prefix-function 'byte-compile-warning-prefix) (warning-type-format "") - (warning-fill-prefix (if fill " ")) - (inhibit-read-only t)) + (warning-fill-prefix (if fill " "))) (display-warning 'bytecomp string level byte-compile-log-buffer))) (defun byte-compile-warn (format &rest args) @@ -2189,7 +2201,10 @@ (when (and (consp (nth 1 form)) (eq (car (nth 1 form)) 'quote) (consp (cdr (nth 1 form))) - (symbolp (nth 1 (nth 1 form)))) + (symbolp (nth 1 (nth 1 form))) + ;; Don't add it if it's already defined. Otherwise, it might + ;; hide the actual definition. + (not (fboundp (nth 1 (nth 1 form))))) (push (cons (nth 1 (nth 1 form)) (cons 'autoload (cdr (cdr form)))) byte-compile-function-environment) @@ -3689,10 +3704,10 @@ that suppresses all warnings during execution of BODY." (declare (indent 1) (debug t)) `(let* ((fbound-list (byte-compile-find-bound-condition - ,condition (list 'fboundp) + ,condition '(fboundp functionp) byte-compile-unresolved-functions)) (bound-list (byte-compile-find-bound-condition - ,condition (list 'boundp 'default-boundp))) + ,condition '(boundp default-boundp))) ;; Maybe add to the bound list. (byte-compile-bound-variables (append bound-list byte-compile-bound-variables))) ------------------------------------------------------------ revno: 110832 committer: Stefan Monnier <monnier@iro.umontreal.ca> branch nick: trunk timestamp: Thu 2012-11-08 09:54:03 -0500 message: * lisp/emacs-lisp/gv.el (gv-deref): Move setter declaration, to fix bootstrap. diff: === modified file 'lisp/emacs-lisp/gv.el' --- lisp/emacs-lisp/gv.el 2012-11-08 14:21:21 +0000 +++ lisp/emacs-lisp/gv.el 2012-11-08 14:54:03 +0000 @@ -447,8 +447,11 @@ "Dereference REF, returning the referenced value. This is like the `*' operator of the C language. REF must have been previously obtained with `gv-ref'." - (declare (gv-setter (lambda (v) `(funcall (cdr ,ref) ,v)))) (funcall (car ref))) +;; Don't use `declare' because it seems to introduce circularity problems: +;; Warning: Eager macro-expansion skipped due to cycle: +;; … => (load "gv.el") => (macroexpand-all (defsubst gv-deref …)) => (macroexpand (defun …)) => (load "gv.el") +(gv-define-setter gv-deref (v ref) `(funcall (cdr ,ref) ,v)) ;;; Vaguely related definitions that should be moved elsewhere. ------------------------------------------------------------ revno: 110831 committer: Stefan Monnier <monnier@iro.umontreal.ca> branch nick: trunk timestamp: Thu 2012-11-08 09:21:21 -0500 message: * lisp/emacs-lisp/gv.el (gv-ref, gv-deref): New function and macro. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-11-08 13:34:06 +0000 +++ lisp/ChangeLog 2012-11-08 14:21:21 +0000 @@ -1,5 +1,11 @@ 2012-11-08 Stefan Monnier <monnier@iro.umontreal.ca> + * emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment): + Byte-compile *before* eval in eval-and-compile. + (byte-compile-log-warning): Remove redundant inhibit-read-only. + (byte-compile-file-form-autoload): Don't hide actual definition. + (byte-compile-maybe-guarded): Accept `functionp' as well. + * emacs-lisp/gv.el (gv-ref, gv-deref): New function and macro. 2012-11-07 Michael Albinus <michael.albinus@gmx.de> === modified file 'lisp/emacs-lisp/gv.el' --- lisp/emacs-lisp/gv.el 2012-11-08 13:34:06 +0000 +++ lisp/emacs-lisp/gv.el 2012-11-08 14:21:21 +0000 @@ -443,7 +443,6 @@ `(cons (lambda () ,getter) (lambda (gv--val) ,(funcall setter 'gv--val))))) -;;;###autoload (defsubst gv-deref (ref) "Dereference REF, returning the referenced value. This is like the `*' operator of the C language. ------------------------------------------------------------ revno: 110830 committer: Dmitry Antipov <dmantipov@yandex.ru> branch nick: trunk timestamp: Thu 2012-11-08 18:10:28 +0400 message: Shrink struct vectorlike_header to the only size field. * lisp.h (enum pvec_type): Avoid explicit enum member values. Adjust comment. (enum More_Lisp_Bits): Change PSEUDOVECTOR_SIZE_BITS and PVEC_TYPE_MASK to arrange new bitfield in the vector header. (PSEUDOVECTOR_REST_BITS, PSEUDOVECTOR_REST_MASK): New members. (PSEUDOVECTOR_AREA_BITS): New member used to extract subtype information from the vector header. Adjust comment. (XSETPVECTYPE, XSETPVECTYPESIZE, XSETTYPED_PSEUDOVECTOR) (PSEUDOVECTOR_TYPEP, DEFUN): Adjust to match new vector header layout. (XSETSUBR, SUBRP): Adjust to match new Lisp_Subr layout. (struct vectorlike_header): Remove next member. Adjust comment. (struct Lisp_Subr): Add convenient header. Adjust comment. (allocate_pseudovector): Adjust prototype. * alloc.c (mark_glyph_matrix, mark_face_cache, allocate_string) (sweep_string, lisp_malloc): Remove useless prototypes. (enum mem_type): Adjust comment. (NEXT_IN_FREE_LIST): New macro. (SETUP_ON_FREE_LIST): Adjust XSETPVECTYPESIZE usage. (Fmake_bool_vector): Likewise. (struct large_vector): New type to represent allocation unit for the vectors with the memory footprint more than VBLOOCK_BYTES_MAX. (large_vectors): Change type to struct large_vector. (allocate_vector_from_block): Simplify. (PSEUDOVECTOR_NBYTES): Replace with... (vector_nbytes): ...new function. Adjust users. (sweep_vectors): Adjust processing of large vectors. (allocate_vectorlike): Likewise. (allocate_pseudovector): Change type of 3rd arg to enum pvec_type. Add easserts. Adjust XSETPVECTYPESIZE usage. (allocate_buffer): Use BUFFER_PVEC_INIT. (live_vector_p): Adjust to match large vector. * buffer.c (init_buffer_once): Use BUFFER_PVEC_INIT. * buffer.h (struct buffer): Add next member. (BUFFER_LISP_SIZE, BUFFER_REST_SIZE, BUFFER_PVEC_INIT): New macros. (FOR_EACH_BUFFER): Adjust to match struct buffer change. * fns.c (internal_equal): Adjust to match enum pvec_type change. (copy_hash_table): Adjust to match vector header change. * lread.c (defsubr): Use XSETPVECTYPE. * .gdbinit (xpr, xbacktrace): Adjust to match vector header change. (xvectype): Likewise. Print PVEC_NORMAL_VECTOR for regular vectors. (xvecsize): New command. diff: === modified file 'src/.gdbinit' --- src/.gdbinit 2012-09-30 20:06:20 +0000 +++ src/.gdbinit 2012-11-08 14:10:28 +0000 @@ -654,13 +654,30 @@ xgetptr $ set $size = ((struct Lisp_Vector *) $ptr)->header.size if ($size & PSEUDOVECTOR_FLAG) - output (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_SIZE_BITS) + output (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_AREA_BITS) else - output $size & ~ARRAY_MARK_FLAG + output PVEC_NORMAL_VECTOR end echo \n end document xvectype +Print the type or vector subtype of $. +This command assumes that $ is a vector or pseudovector. +end + +define xvecsize + xgetptr $ + set $size = ((struct Lisp_Vector *) $ptr)->header.size + if ($size & PSEUDOVECTOR_FLAG) + output ($size & PSEUDOVECTOR_SIZE_MASK) + echo \n + output (($size & PSEUDOVECTOR_REST_MASK) >> PSEUDOVECTOR_SIZE_BITS) + else + output ($size & ~ARRAY_MARK_FLAG) + end + echo \n +end +document xvecsize Print the size or vector subtype of $. This command assumes that $ is a vector or pseudovector. end @@ -996,7 +1013,7 @@ if $type == Lisp_Vectorlike set $size = ((struct Lisp_Vector *) $ptr)->header.size if ($size & PSEUDOVECTOR_FLAG) - set $vec = (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_SIZE_BITS) + set $vec = (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_AREA_BITS) if $vec == PVEC_NORMAL_VECTOR xvector end @@ -1132,7 +1149,7 @@ xgetptr ($bt->function) set $size = ((struct Lisp_Vector *) $ptr)->header.size if ($size & PSEUDOVECTOR_FLAG) - output (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_SIZE_BITS) + output (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_AREA_BITS) else output $size & ~ARRAY_MARK_FLAG end === modified file 'src/ChangeLog' --- src/ChangeLog 2012-11-08 09:26:40 +0000 +++ src/ChangeLog 2012-11-08 14:10:28 +0000 @@ -1,5 +1,52 @@ 2012-11-08 Dmitry Antipov <dmantipov@yandex.ru> + Shrink struct vectorlike_header to the only size field. + * lisp.h (enum pvec_type): Avoid explicit enum member values. + Adjust comment. + (enum More_Lisp_Bits): Change PSEUDOVECTOR_SIZE_BITS and + PVEC_TYPE_MASK to arrange new bitfield in the vector header. + (PSEUDOVECTOR_REST_BITS, PSEUDOVECTOR_REST_MASK): New members. + (PSEUDOVECTOR_AREA_BITS): New member used to extract subtype + information from the vector header. Adjust comment. + (XSETPVECTYPE, XSETPVECTYPESIZE, XSETTYPED_PSEUDOVECTOR) + (PSEUDOVECTOR_TYPEP, DEFUN): Adjust to match new vector header + layout. + (XSETSUBR, SUBRP): Adjust to match new Lisp_Subr layout. + (struct vectorlike_header): Remove next member. Adjust comment. + (struct Lisp_Subr): Add convenient header. Adjust comment. + (allocate_pseudovector): Adjust prototype. + * alloc.c (mark_glyph_matrix, mark_face_cache, allocate_string) + (sweep_string, lisp_malloc): Remove useless prototypes. + (enum mem_type): Adjust comment. + (NEXT_IN_FREE_LIST): New macro. + (SETUP_ON_FREE_LIST): Adjust XSETPVECTYPESIZE usage. + (Fmake_bool_vector): Likewise. + (struct large_vector): New type to represent allocation unit for + the vectors with the memory footprint more than VBLOOCK_BYTES_MAX. + (large_vectors): Change type to struct large_vector. + (allocate_vector_from_block): Simplify. + (PSEUDOVECTOR_NBYTES): Replace with... + (vector_nbytes): ...new function. Adjust users. + (sweep_vectors): Adjust processing of large vectors. + (allocate_vectorlike): Likewise. + (allocate_pseudovector): Change type of 3rd arg to enum pvec_type. + Add easserts. Adjust XSETPVECTYPESIZE usage. + (allocate_buffer): Use BUFFER_PVEC_INIT. + (live_vector_p): Adjust to match large vector. + * buffer.c (init_buffer_once): Use BUFFER_PVEC_INIT. + * buffer.h (struct buffer): Add next member. + (BUFFER_LISP_SIZE, BUFFER_REST_SIZE, BUFFER_PVEC_INIT): + New macros. + (FOR_EACH_BUFFER): Adjust to match struct buffer change. + * fns.c (internal_equal): Adjust to match enum pvec_type change. + (copy_hash_table): Adjust to match vector header change. + * lread.c (defsubr): Use XSETPVECTYPE. + * .gdbinit (xpr, xbacktrace): Adjust to match vector header change. + (xvectype): Likewise. Print PVEC_NORMAL_VECTOR for regular vectors. + (xvecsize): New command. + +2012-11-08 Dmitry Antipov <dmantipov@yandex.ru> + * keyboard.c (event_to_kboard): Do not dereference frame_or_window field of SELECTION_REQUEST_EVENT and SELECTION_CLEAR_EVENT events (Bug#12814). === modified file 'src/alloc.c' --- src/alloc.c 2012-10-19 06:43:12 +0000 +++ src/alloc.c 2012-11-08 14:10:28 +0000 @@ -216,23 +216,19 @@ static void mark_terminals (void); static void gc_sweep (void); static Lisp_Object make_pure_vector (ptrdiff_t); -static void mark_glyph_matrix (struct glyph_matrix *); -static void mark_face_cache (struct face_cache *); static void mark_buffer (struct buffer *); #if !defined REL_ALLOC || defined SYSTEM_MALLOC static void refill_memory_reserve (void); #endif -static struct Lisp_String *allocate_string (void); static void compact_small_strings (void); static void free_large_strings (void); -static void sweep_strings (void); static void free_misc (Lisp_Object); extern Lisp_Object which_symbols (Lisp_Object, EMACS_INT) EXTERNALLY_VISIBLE; -/* When scanning the C stack for live Lisp objects, Emacs keeps track - of what memory allocated via lisp_malloc is intended for what - purpose. This enumeration specifies the type of memory. */ +/* When scanning the C stack for live Lisp objects, Emacs keeps track of + what memory allocated via lisp_malloc and lisp_align_malloc is intended + for what purpose. This enumeration specifies the type of memory. */ enum mem_type { @@ -243,10 +239,9 @@ MEM_TYPE_MISC, MEM_TYPE_SYMBOL, MEM_TYPE_FLOAT, - /* We used to keep separate mem_types for subtypes of vectors such as - process, hash_table, frame, terminal, and window, but we never made - use of the distinction, so it only caused source-code complexity - and runtime slowdown. Minor but pointless. */ + /* Since all non-bool pseudovectors are small enough to be + allocated from vector blocks, this memory type denotes + large regular vectors and large bool pseudovectors. */ MEM_TYPE_VECTORLIKE, /* Special type to denote vector blocks. */ MEM_TYPE_VECTOR_BLOCK, @@ -254,9 +249,6 @@ MEM_TYPE_SPARE }; -static void *lisp_malloc (size_t, enum mem_type); - - #if GC_MARK_STACK || defined GC_MALLOC_CHECK #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES @@ -2040,7 +2032,7 @@ val = Fmake_vector (make_number (length_in_elts + extra_bool_elts), Qnil); /* No Lisp_Object to trace in there. */ - XSETPVECTYPESIZE (XVECTOR (val), PVEC_BOOL_VECTOR, 0); + XSETPVECTYPESIZE (XVECTOR (val), PVEC_BOOL_VECTOR, 0, 0); p = XBOOL_VECTOR (val); p->size = XFASTINT (length); @@ -2619,19 +2611,49 @@ #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)) + /* Common shortcut to setup vector on a free list. */ -#define SETUP_ON_FREE_LIST(v, nbytes, index) \ - do { \ - XSETPVECTYPESIZE (v, PVEC_FREE, nbytes); \ - eassert ((nbytes) % roundup_size == 0); \ - (index) = VINDEX (nbytes); \ - eassert ((index) < VECTOR_MAX_FREE_LIST_INDEX); \ - (v)->header.next.vector = vector_free_lists[index]; \ - vector_free_lists[index] = (v); \ - total_free_vector_slots += (nbytes) / word_size; \ +#define SETUP_ON_FREE_LIST(v, nbytes, tmp) \ + do { \ + (tmp) = ((nbytes - header_size) / word_size); \ + XSETPVECTYPESIZE (v, PVEC_FREE, 0, (tmp)); \ + eassert ((nbytes) % roundup_size == 0); \ + (tmp) = VINDEX (nbytes); \ + eassert ((tmp) < VECTOR_MAX_FREE_LIST_INDEX); \ + NEXT_IN_FREE_LIST (v) = vector_free_lists[tmp]; \ + vector_free_lists[tmp] = (v); \ + total_free_vector_slots += (nbytes) / word_size; \ } while (0) +/* This internal type is used to maintain the list of large vectors + which are allocated at their own, e.g. outside of vector blocks. */ + +struct large_vector +{ + union { + struct large_vector *vector; +#if USE_LSB_TAG + /* We need to maintain ROUNDUP_SIZE alignment for the vector member. */ + unsigned char c[vroundup (sizeof (struct large_vector *))]; +#endif + } next; + struct Lisp_Vector v; +}; + +/* This internal type is used to maintain an underlying storage + for small vectors. */ + struct vector_block { char data[VECTOR_BLOCK_BYTES]; @@ -2649,7 +2671,7 @@ /* Singly-linked list of large vectors. */ -static struct Lisp_Vector *large_vectors; +static struct large_vector *large_vectors; /* The only vector with 0 slots, allocated from pure space. */ @@ -2693,7 +2715,7 @@ static struct Lisp_Vector * allocate_vector_from_block (size_t nbytes) { - struct Lisp_Vector *vector, *rest; + struct Lisp_Vector *vector; struct vector_block *block; size_t index, restbytes; @@ -2706,8 +2728,7 @@ if (vector_free_lists[index]) { vector = vector_free_lists[index]; - vector_free_lists[index] = vector->header.next.vector; - vector->header.next.nbytes = nbytes; + vector_free_lists[index] = NEXT_IN_FREE_LIST (vector); total_free_vector_slots -= nbytes / word_size; return vector; } @@ -2721,16 +2742,14 @@ { /* This vector is larger than requested. */ vector = vector_free_lists[index]; - vector_free_lists[index] = vector->header.next.vector; - vector->header.next.nbytes = nbytes; + vector_free_lists[index] = NEXT_IN_FREE_LIST (vector); total_free_vector_slots -= nbytes / word_size; /* Excess bytes are used for the smaller vector, which should be set on an appropriate free list. */ restbytes = index * roundup_size + VBLOCK_BYTES_MIN - nbytes; eassert (restbytes % roundup_size == 0); - rest = ADVANCE (vector, nbytes); - SETUP_ON_FREE_LIST (rest, restbytes, index); + SETUP_ON_FREE_LIST (ADVANCE (vector, nbytes), restbytes, index); return vector; } @@ -2739,7 +2758,6 @@ /* New vector will be at the beginning of this block. */ vector = (struct Lisp_Vector *) block->data; - vector->header.next.nbytes = nbytes; /* If the rest of space from this block is large enough for one-slot vector at least, set up it on a free list. */ @@ -2747,11 +2765,10 @@ if (restbytes >= VBLOCK_BYTES_MIN) { eassert (restbytes % roundup_size == 0); - rest = ADVANCE (vector, nbytes); - SETUP_ON_FREE_LIST (rest, restbytes, index); + SETUP_ON_FREE_LIST (ADVANCE (vector, nbytes), restbytes, index); } return vector; - } +} /* Nonzero if VECTOR pointer is valid pointer inside BLOCK. */ @@ -2759,15 +2776,30 @@ ((char *) (vector) <= (block)->data \ + VECTOR_BLOCK_BYTES - VBLOCK_BYTES_MIN) -/* Number of bytes used by vector-block-allocated object. This is the only - place where we actually use the `nbytes' field of the vector-header. - I.e. we could get rid of the `nbytes' field by computing it based on the - vector-type. */ - -#define PSEUDOVECTOR_NBYTES(vector) \ - (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE) \ - ? vector->header.size & PSEUDOVECTOR_SIZE_MASK \ - : vector->header.next.nbytes) +/* Return the memory footprint of V in bytes. */ + +static ptrdiff_t +vector_nbytes (struct Lisp_Vector *v) +{ + ptrdiff_t size = v->header.size & ~ARRAY_MARK_FLAG; + + if (size & PSEUDOVECTOR_FLAG) + { + if (PSEUDOVECTOR_TYPEP (&v->header, PVEC_BOOL_VECTOR)) + size = (bool_header_size + + (((struct Lisp_Bool_Vector *) v)->size + + BOOL_VECTOR_BITS_PER_CHAR - 1) + / BOOL_VECTOR_BITS_PER_CHAR); + else + size = (header_size + + ((size & PSEUDOVECTOR_SIZE_MASK) + + ((size & PSEUDOVECTOR_REST_MASK) + >> PSEUDOVECTOR_SIZE_BITS)) * word_size); + } + else + size = header_size + size * word_size; + return vroundup (size); +} /* Reclaim space used by unmarked vectors. */ @@ -2775,7 +2807,8 @@ sweep_vectors (void) { struct vector_block *block = vector_blocks, **bprev = &vector_blocks; - struct Lisp_Vector *vector, *next, **vprev = &large_vectors; + struct large_vector *lv, **lvprev = &large_vectors; + struct Lisp_Vector *vector, *next; total_vectors = total_vector_slots = total_free_vector_slots = 0; memset (vector_free_lists, 0, sizeof (vector_free_lists)); @@ -2785,6 +2818,7 @@ for (block = vector_blocks; block; block = *bprev) { bool free_this_block = 0; + ptrdiff_t nbytes; for (vector = (struct Lisp_Vector *) block->data; VECTOR_IN_BLOCK (vector, block); vector = next) @@ -2793,14 +2827,16 @@ { VECTOR_UNMARK (vector); total_vectors++; - total_vector_slots += vector->header.next.nbytes / word_size; - next = ADVANCE (vector, vector->header.next.nbytes); + nbytes = vector_nbytes (vector); + total_vector_slots += nbytes / word_size; + next = ADVANCE (vector, nbytes); } else { - ptrdiff_t nbytes = PSEUDOVECTOR_NBYTES (vector); - ptrdiff_t total_bytes = nbytes; + ptrdiff_t total_bytes; + nbytes = vector_nbytes (vector); + total_bytes = nbytes; next = ADVANCE (vector, nbytes); /* While NEXT is not marked, try to coalesce with VECTOR, @@ -2810,7 +2846,7 @@ { if (VECTOR_MARKED_P (next)) break; - nbytes = PSEUDOVECTOR_NBYTES (next); + nbytes = vector_nbytes (next); total_bytes += nbytes; next = ADVANCE (next, nbytes); } @@ -2844,8 +2880,9 @@ /* Sweep large vectors. */ - for (vector = large_vectors; vector; vector = *vprev) + for (lv = large_vectors; lv; lv = *lvprev) { + vector = &lv->v; if (VECTOR_MARKED_P (vector)) { VECTOR_UNMARK (vector); @@ -2867,12 +2904,12 @@ else total_vector_slots += header_size / word_size + vector->header.size; - vprev = &vector->header.next.vector; + lvprev = &lv->next.vector; } else { - *vprev = vector->header.next.vector; - lisp_free (vector); + *lvprev = lv->next.vector; + lisp_free (lv); } } } @@ -2904,9 +2941,12 @@ p = allocate_vector_from_block (vroundup (nbytes)); else { - p = lisp_malloc (nbytes, MEM_TYPE_VECTORLIKE); - p->header.next.vector = large_vectors; - large_vectors = p; + struct large_vector *lv + = lisp_malloc (sizeof (*lv) + (len - 1) * word_size, + MEM_TYPE_VECTORLIKE); + lv->next.vector = large_vectors; + large_vectors = lv; + p = &lv->v; } #ifdef DOUG_LEA_MALLOC @@ -2943,16 +2983,21 @@ /* Allocate other vector-like structures. */ struct Lisp_Vector * -allocate_pseudovector (int memlen, int lisplen, int tag) +allocate_pseudovector (int memlen, int lisplen, enum pvec_type tag) { struct Lisp_Vector *v = allocate_vectorlike (memlen); int i; + /* Catch bogus values. */ + eassert (tag <= PVEC_FONT); + eassert (memlen - lisplen <= (1 << PSEUDOVECTOR_REST_BITS) - 1); + eassert (lisplen <= (1 << PSEUDOVECTOR_SIZE_BITS) - 1); + /* Only the first lisplen slots will be traced normally by the GC. */ for (i = 0; i < lisplen; ++i) v->contents[i] = Qnil; - XSETPVECTYPESIZE (v, tag, lisplen); + XSETPVECTYPESIZE (v, tag, lisplen, memlen - lisplen); return v; } @@ -2961,10 +3006,9 @@ { struct buffer *b = lisp_malloc (sizeof *b, MEM_TYPE_BUFFER); - XSETPVECTYPESIZE (b, PVEC_BUFFER, (offsetof (struct buffer, own_text) - - header_size) / word_size); + BUFFER_PVEC_INIT (b); /* Put B on the chain of all buffers including killed ones. */ - b->header.next.buffer = all_buffers; + b->next = all_buffers; all_buffers = b; /* Note that the rest fields of B are not initialized. */ return b; @@ -4068,16 +4112,15 @@ while (VECTOR_IN_BLOCK (vector, block) && vector <= (struct Lisp_Vector *) p) { - if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE)) - vector = ADVANCE (vector, (vector->header.size - & PSEUDOVECTOR_SIZE_MASK)); - else if (vector == p) + if (!PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE) && vector == p) return 1; else - vector = ADVANCE (vector, vector->header.next.nbytes); + vector = ADVANCE (vector, vector_nbytes (vector)); } } - else if (m->type == MEM_TYPE_VECTORLIKE && p == m->start) + else if (m->type == MEM_TYPE_VECTORLIKE + && (char *) p == ((char *) m->start + + offsetof (struct large_vector, v))) /* This memory node corresponds to a large vector. */ return 1; return 0; @@ -5687,7 +5730,7 @@ if (ptr->header.size & PSEUDOVECTOR_FLAG) pvectype = ((ptr->header.size & PVEC_TYPE_MASK) - >> PSEUDOVECTOR_SIZE_BITS); + >> PSEUDOVECTOR_AREA_BITS); else pvectype = PVEC_NORMAL_VECTOR; @@ -6317,7 +6360,7 @@ for (buffer = all_buffers; buffer; buffer = *bprev) if (!VECTOR_MARKED_P (buffer)) { - *bprev = buffer->header.next.buffer; + *bprev = buffer->next; lisp_free (buffer); } else @@ -6326,7 +6369,7 @@ /* Do not use buffer_(set|get)_intervals here. */ buffer->text->intervals = balance_intervals (buffer->text->intervals); total_buffers++; - bprev = &buffer->header.next.buffer; + bprev = &buffer->next; } } === modified file 'src/buffer.c' --- src/buffer.c 2012-11-06 17:40:07 +0000 +++ src/buffer.c 2012-11-08 14:10:28 +0000 @@ -5105,11 +5105,6 @@ init_buffer_once (void) { int idx; - /* If you add, remove, or reorder Lisp_Objects in a struct buffer, make - sure that this is still correct. Otherwise, mark_vectorlike may not - trace all Lisp_Objects in buffer_defaults and buffer_local_symbols. */ - const int pvecsize - = (offsetof (struct buffer, own_text) - header_size) / word_size; memset (buffer_permanent_local_flags, 0, sizeof buffer_permanent_local_flags); @@ -5132,8 +5127,8 @@ /* This is not strictly necessary, but let's make them initialized. */ bset_name (&buffer_defaults, build_pure_c_string (" *buffer-defaults*")); bset_name (&buffer_local_symbols, build_pure_c_string (" *buffer-local-symbols*")); - XSETPVECTYPESIZE (&buffer_defaults, PVEC_BUFFER, pvecsize); - XSETPVECTYPESIZE (&buffer_local_symbols, PVEC_BUFFER, pvecsize); + BUFFER_PVEC_INIT (&buffer_defaults); + BUFFER_PVEC_INIT (&buffer_local_symbols); /* Set up the default values of various buffer slots. */ /* Must do these before making the first buffer! */ === modified file 'src/buffer.h' --- src/buffer.h 2012-10-17 04:58:15 +0000 +++ src/buffer.h 2012-11-08 14:10:28 +0000 @@ -482,11 +482,6 @@ struct buffer { - /* HEADER.NEXT is the next buffer, in chain of all buffers, including killed - buffers. This chain, starting from all_buffers, is used only for garbage - collection, in order to collect killed buffers properly. Note that large - vectors and large pseudo-vector objects are all on another chain starting - from large_vectors. */ struct vectorlike_header header; /* The name of this buffer. */ @@ -750,6 +745,9 @@ In an indirect buffer, this is the own_text field of another buffer. */ struct buffer_text *text; + /* Next buffer, in chain of all buffers, including killed ones. */ + struct buffer *next; + /* Char position of point in buffer. */ ptrdiff_t pt; @@ -959,6 +957,27 @@ b->INTERNAL_FIELD (width_table) = val; } +/* Number of Lisp_Objects at the beginning of struct buffer. + If you add, remove, or reorder Lisp_Objects within buffer + structure, make sure that this is still correct. */ + +#define BUFFER_LISP_SIZE \ + ((offsetof (struct buffer, own_text) - header_size) / word_size) + +/* Size of the struct buffer part beyond leading Lisp_Objects, in word_size + units. Rounding is needed for --with-wide-int configuration. */ + +#define BUFFER_REST_SIZE \ + ((((sizeof (struct buffer) - offsetof (struct buffer, own_text)) \ + + (word_size - 1)) & ~(word_size - 1)) / word_size) + +/* Initialize the pseudovector header of buffer object. BUFFER_LISP_SIZE + is required for GC, but BUFFER_REST_SIZE is set up just to be consistent + with other pseudovectors. */ + +#define BUFFER_PVEC_INIT(b) \ + XSETPVECTYPESIZE (b, PVEC_BUFFER, BUFFER_LISP_SIZE, BUFFER_REST_SIZE) + /* Convenient check whether buffer B is live. */ #define BUFFER_LIVE_P(b) (!NILP (BVAR (b, name))) @@ -986,7 +1005,7 @@ /* Used to iterate over the chain above. */ #define FOR_EACH_BUFFER(b) \ - for ((b) = all_buffers; (b); (b) = (b)->header.next.buffer) + for ((b) = all_buffers; (b); (b) = (b)->next) /* This points to the current buffer. */ === modified file 'src/fns.c' --- src/fns.c 2012-10-19 00:54:35 +0000 +++ src/fns.c 2012-11-08 14:10:28 +0000 @@ -2076,9 +2076,8 @@ are sensible to compare, so eliminate the others now. */ if (size & PSEUDOVECTOR_FLAG) { - if (!(size & ((PVEC_COMPILED | PVEC_CHAR_TABLE - | PVEC_SUB_CHAR_TABLE | PVEC_FONT) - << PSEUDOVECTOR_SIZE_BITS))) + if (((size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_AREA_BITS) + < PVEC_COMPILED) return 0; size &= PSEUDOVECTOR_SIZE_MASK; } @@ -3661,12 +3660,9 @@ { Lisp_Object table; struct Lisp_Hash_Table *h2; - struct Lisp_Vector *next; h2 = allocate_hash_table (); - next = h2->header.next.vector; *h2 = *h1; - h2->header.next.vector = next; h2->key_and_value = Fcopy_sequence (h1->key_and_value); h2->hash = Fcopy_sequence (h1->hash); h2->next = Fcopy_sequence (h1->next); === modified file 'src/lisp.h' --- src/lisp.h 2012-11-06 20:48:35 +0000 +++ src/lisp.h 2012-11-08 14:10:28 +0000 @@ -408,14 +408,11 @@ PVEC_WINDOW_CONFIGURATION, PVEC_SUBR, PVEC_OTHER, - /* These last 4 are special because we OR them in fns.c:internal_equal, - so they have to use a disjoint bit pattern: - if (!(size & (PVEC_COMPILED | PVEC_CHAR_TABLE - | PVEC_SUB_CHAR_TABLE | PVEC_FONT))) */ - PVEC_COMPILED = 0x10, - PVEC_CHAR_TABLE = 0x20, - PVEC_SUB_CHAR_TABLE = 0x30, - PVEC_FONT = 0x40 + /* These should be last, check internal_equal to see why. */ + PVEC_COMPILED, + PVEC_CHAR_TABLE, + PVEC_SUB_CHAR_TABLE, + PVEC_FONT /* Should be last because it's used for range checking. */ }; /* DATA_SEG_BITS forces extra bits to be or'd in with any pointers @@ -435,9 +432,18 @@ only the number of Lisp_Object fields (that need to be traced by GC). The distinction is used, e.g., by Lisp_Process, which places extra non-Lisp_Object fields at the end of the structure. */ - PSEUDOVECTOR_SIZE_BITS = 16, + PSEUDOVECTOR_SIZE_BITS = 12, PSEUDOVECTOR_SIZE_MASK = (1 << PSEUDOVECTOR_SIZE_BITS) - 1, - PVEC_TYPE_MASK = 0x0fff << PSEUDOVECTOR_SIZE_BITS, + + /* To calculate the memory footprint of the pseudovector, it's useful + to store the size of non-Lisp area in word_size units here. */ + PSEUDOVECTOR_REST_BITS = 12, + PSEUDOVECTOR_REST_MASK = (((1 << PSEUDOVECTOR_REST_BITS) - 1) + << PSEUDOVECTOR_SIZE_BITS), + + /* Used to extract pseudovector subtype information. */ + PSEUDOVECTOR_AREA_BITS = PSEUDOVECTOR_SIZE_BITS + PSEUDOVECTOR_REST_BITS, + PVEC_TYPE_MASK = 0x3f << PSEUDOVECTOR_AREA_BITS, /* Number of bits to put in each character in the internal representation of bool vectors. This should not vary across implementations. */ @@ -608,13 +614,13 @@ /* Pseudovector types. */ -#define XSETPVECTYPE(v, code) XSETTYPED_PVECTYPE (v, header.size, code) -#define XSETTYPED_PVECTYPE(v, size_member, code) \ - ((v)->size_member |= PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_SIZE_BITS)) -#define XSETPVECTYPESIZE(v, code, sizeval) \ +#define XSETPVECTYPE(v, code) \ + ((v)->header.size |= PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_AREA_BITS)) +#define XSETPVECTYPESIZE(v, code, lispsize, restsize) \ ((v)->header.size = (PSEUDOVECTOR_FLAG \ - | ((code) << PSEUDOVECTOR_SIZE_BITS) \ - | (sizeval))) + | ((code) << PSEUDOVECTOR_AREA_BITS) \ + | ((restsize) << PSEUDOVECTOR_SIZE_BITS) \ + | (lispsize))) /* The cast to struct vectorlike_header * avoids aliasing issues. */ #define XSETPSEUDOVECTOR(a, b, code) \ @@ -626,16 +632,14 @@ #define XSETTYPED_PSEUDOVECTOR(a, b, size, code) \ (XSETVECTOR (a, b), \ eassert ((size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) \ - == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_SIZE_BITS)))) + == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_AREA_BITS)))) #define XSETWINDOW_CONFIGURATION(a, b) \ (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW_CONFIGURATION)) #define XSETPROCESS(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_PROCESS)) #define XSETWINDOW(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW)) #define XSETTERMINAL(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_TERMINAL)) -/* XSETSUBR is special since Lisp_Subr lacks struct vectorlike_header. */ -#define XSETSUBR(a, b) \ - XSETTYPED_PSEUDOVECTOR (a, b, XSUBR (a)->size, PVEC_SUBR) +#define XSETSUBR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUBR)) #define XSETCOMPILED(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_COMPILED)) #define XSETBUFFER(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BUFFER)) #define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE)) @@ -802,7 +806,7 @@ }; /* Header of vector-like objects. This documents the layout constraints on - vectors and pseudovectors other than struct Lisp_Subr. It also prevents + vectors and pseudovectors (objects of PVEC_xxx subtype). It also prevents compilers from being fooled by Emacs's type punning: the XSETPSEUDOVECTOR and PSEUDOVECTORP macros cast their pointers to struct vectorlike_header *, because when two such pointers potentially alias, a compiler won't @@ -810,43 +814,26 @@ <http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8546>. */ struct vectorlike_header { - /* This field contains various pieces of information: + /* The only field contains various pieces of information: - The MSB (ARRAY_MARK_FLAG) holds the gcmarkbit. - The next bit (PSEUDOVECTOR_FLAG) indicates whether this is a plain vector (0) or a pseudovector (1). - If PSEUDOVECTOR_FLAG is 0, the rest holds the size (number of slots) of the vector. - - If PSEUDOVECTOR_FLAG is 1, the rest is subdivided into - a "pvec type" tag held in PVEC_TYPE_MASK and a size held in the lowest - PSEUDOVECTOR_SIZE_BITS. That size normally indicates the number of - Lisp_Object slots at the beginning of the object that need to be - traced by the GC, tho some types use it slightly differently. - - E.g. if the pvec type is PVEC_FREE it means this is an unallocated - vector on a free-list and PSEUDOVECTOR_SIZE_BITS indicates its size - in bytes. */ + - If PSEUDOVECTOR_FLAG is 1, the rest is subdivided into three fields: + - a) pseudovector subtype held in PVEC_TYPE_MASK field; + - b) number of Lisp_Objects slots at the beginning of the object + held in PSEUDOVECTOR_SIZE_MASK field. These objects are always + traced by the GC; + - c) size of the rest fields held in PSEUDOVECTOR_REST_MASK and + measured in word_size units. Rest fields may also include + Lisp_Objects, but these objects usually needs some special treatment + during GC. + There are some exceptions. For PVEC_FREE, b) is always zero. For + PVEC_BOOL_VECTOR and PVEC_SUBR, both b) and c) are always zero. + Current layout limits the pseudovectors to 63 PVEC_xxx subtypes, + 4095 Lisp_Objects in GC-ed area and 4095 word-sized other slots. */ ptrdiff_t size; - - /* When the vector is allocated from a vector block, NBYTES is used - if the vector is not on a free list, and VECTOR is used otherwise. - For large vector-like objects, BUFFER or VECTOR is used as a pointer - to the next vector-like object. It is generally a buffer or a - Lisp_Vector alias, so for convenience it is a union instead of a - pointer: this way, one can write P->next.vector instead of ((struct - Lisp_Vector *) P->next). */ - union { - /* This is only needed for small vectors that are not free because the - `size' field only gives us the number of Lisp_Object slots, whereas we - need to know the total size, including non-Lisp_Object data. - FIXME: figure out a way to store this info elsewhere so we can - finally get rid of this extra word of overhead. */ - ptrdiff_t nbytes; - struct buffer *buffer; - /* FIXME: This can be removed: For large vectors, this field could be - placed *before* the vector itself. And for small vectors on a free - list, this field could be stored in the vector's bytes, since the - empty vector is handled specially anyway. */ - struct Lisp_Vector *vector; - } next; }; /* Regular vector is just a header plus array of Lisp_Objects. */ @@ -1020,15 +1007,11 @@ /* This structure describes a built-in function. It is generated by the DEFUN macro only. - defsubr makes it into a Lisp object. - - This type is treated in most respects as a pseudovector, - but since we never dynamically allocate or free them, - we don't need a struct vectorlike_header and its 'next' field. */ + defsubr makes it into a Lisp object. */ struct Lisp_Subr { - ptrdiff_t size; + struct vectorlike_header header; union { Lisp_Object (*a0) (void); Lisp_Object (*a1) (Lisp_Object); @@ -1709,7 +1692,7 @@ #define PSEUDOVECTOR_TYPEP(v, code) \ (((v)->size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) \ - == (PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_SIZE_BITS))) + == (PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_AREA_BITS))) /* True if object X, with internal type struct T *, is a pseudovector whose code is CODE. */ @@ -1722,8 +1705,7 @@ #define PROCESSP(x) PSEUDOVECTORP (x, PVEC_PROCESS) #define WINDOWP(x) PSEUDOVECTORP (x, PVEC_WINDOW) #define TERMINALP(x) PSEUDOVECTORP (x, PVEC_TERMINAL) -/* SUBRP is special since Lisp_Subr lacks struct vectorlike_header. */ -#define SUBRP(x) TYPED_PSEUDOVECTORP (x, Lisp_Subr, PVEC_SUBR) +#define SUBRP(x) PSEUDOVECTORP (x, PVEC_SUBR) #define COMPILEDP(x) PSEUDOVECTORP (x, PVEC_COMPILED) #define BUFFERP(x) PSEUDOVECTORP (x, PVEC_BUFFER) #define CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_CHAR_TABLE) @@ -1898,8 +1880,8 @@ #define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \ Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \ static struct Lisp_Subr alignas (GCALIGNMENT) sname = \ - { (PVEC_SUBR << PSEUDOVECTOR_SIZE_BITS) \ - | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)), \ + { { (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) \ + | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)) }, \ { (Lisp_Object (__cdecl *)(void))fnname }, \ minargs, maxargs, lname, intspec, 0}; \ Lisp_Object fnname @@ -1907,8 +1889,8 @@ #define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \ Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \ static struct Lisp_Subr alignas (GCALIGNMENT) sname = \ - { PVEC_SUBR << PSEUDOVECTOR_SIZE_BITS, \ - { .a ## maxargs = fnname }, \ + { { PVEC_SUBR << PSEUDOVECTOR_AREA_BITS }, \ + { .a ## maxargs = fnname }, \ minargs, maxargs, lname, intspec, 0}; \ Lisp_Object fnname #endif @@ -2952,7 +2934,7 @@ extern Lisp_Object Qautomatic_gc; extern Lisp_Object Qchar_table_extra_slots; extern struct Lisp_Vector *allocate_vector (EMACS_INT); -extern struct Lisp_Vector *allocate_pseudovector (int memlen, int lisplen, int tag); +extern struct Lisp_Vector *allocate_pseudovector (int, int, enum pvec_type); #define ALLOCATE_PSEUDOVECTOR(typ,field,tag) \ ((typ*) \ allocate_pseudovector \ === modified file 'src/lread.c' --- src/lread.c 2012-10-20 12:50:49 +0000 +++ src/lread.c 2012-11-08 14:10:28 +0000 @@ -3981,7 +3981,7 @@ { Lisp_Object sym, tem; sym = intern_c_string (sname->symbol_name); - XSETTYPED_PVECTYPE (sname, size, PVEC_SUBR); + XSETPVECTYPE (sname, PVEC_SUBR); XSETSUBR (tem, sname); set_symbol_function (sym, tem); } ------------------------------------------------------------ revno: 110829 committer: Stefan Monnier <monnier@iro.umontreal.ca> branch nick: trunk timestamp: Thu 2012-11-08 08:34:06 -0500 message: * lisp/emacs-lisp/gv.el (gv-ref, gv-deref): New function and macro. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-11-07 16:55:39 +0000 +++ lisp/ChangeLog 2012-11-08 13:34:06 +0000 @@ -1,3 +1,7 @@ +2012-11-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/gv.el (gv-ref, gv-deref): New function and macro. + 2012-11-07 Michael Albinus <michael.albinus@gmx.de> * notifications.el (notifications-get-server-information-method): === modified file 'lisp/emacs-lisp/gv.el' --- lisp/emacs-lisp/gv.el 2012-10-18 12:56:10 +0000 +++ lisp/emacs-lisp/gv.el 2012-11-08 13:34:06 +0000 @@ -433,6 +433,24 @@ `(logior (logand ,v ,mask) (logand ,getter (lognot ,mask)))))))))) +;;; References + +;;;###autoload +(defmacro gv-ref (place) + "Return a reference to PLACE. +This is like the `&' operator of the C language." + (gv-letplace (getter setter) place + `(cons (lambda () ,getter) + (lambda (gv--val) ,(funcall setter 'gv--val))))) + +;;;###autoload +(defsubst gv-deref (ref) + "Dereference REF, returning the referenced value. +This is like the `*' operator of the C language. +REF must have been previously obtained with `gv-ref'." + (declare (gv-setter (lambda (v) `(funcall (cdr ,ref) ,v)))) + (funcall (car ref))) + ;;; Vaguely related definitions that should be moved elsewhere. ;; (defun alist-get (key alist) ------------------------------------------------------------ revno: 110828 committer: Dmitry Antipov <dmantipov@yandex.ru> branch nick: trunk timestamp: Thu 2012-11-08 13:26:40 +0400 message: * keyboard.c (event_to_kboard): Do not dereference frame_or_window field of SELECTION_REQUEST_EVENT and SELECTION_CLEAR_EVENT events (Bug#12814). * xterm.h (struct selection_input_event): Adjust comment. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-11-07 21:48:18 +0000 +++ src/ChangeLog 2012-11-08 09:26:40 +0000 @@ -1,3 +1,10 @@ +2012-11-08 Dmitry Antipov <dmantipov@yandex.ru> + + * keyboard.c (event_to_kboard): Do not dereference + frame_or_window field of SELECTION_REQUEST_EVENT + and SELECTION_CLEAR_EVENT events (Bug#12814). + * xterm.h (struct selection_input_event): Adjust comment. + 2012-11-07 Eli Zaretskii <eliz@gnu.org> * w32fns.c (modifier_set): Don't report modifiers from toggle key, === modified file 'src/keyboard.c' --- src/keyboard.c 2012-11-02 09:44:08 +0000 +++ src/keyboard.c 2012-11-08 09:26:40 +0000 @@ -3416,13 +3416,20 @@ static KBOARD * event_to_kboard (struct input_event *event) { - Lisp_Object obj = event->frame_or_window; - /* There are some events that set this field to nil or string. */ - if (WINDOWP (obj)) - obj = WINDOW_FRAME (XWINDOW (obj)); - /* Also ignore dead frames here. */ - return ((FRAMEP (obj) && FRAME_LIVE_P (XFRAME (obj))) - ? FRAME_KBOARD (XFRAME (obj)) : NULL); + /* Not applicable for these special events. */ + if (event->kind == SELECTION_REQUEST_EVENT + || event->kind == SELECTION_CLEAR_EVENT) + return NULL; + else + { + Lisp_Object obj = event->frame_or_window; + /* There are some events that set this field to nil or string. */ + if (WINDOWP (obj)) + obj = WINDOW_FRAME (XWINDOW (obj)); + /* Also ignore dead frames here. */ + return ((FRAMEP (obj) && FRAME_LIVE_P (XFRAME (obj))) + ? FRAME_KBOARD (XFRAME (obj)) : NULL); + } } #ifdef subprocesses === modified file 'src/xterm.h' --- src/xterm.h 2012-10-07 22:31:58 +0000 +++ src/xterm.h 2012-11-08 09:26:40 +0000 @@ -890,10 +890,8 @@ by this structure. */ /* For an event of kind SELECTION_REQUEST_EVENT, - this structure really describes the contents. - **Don't make this struct longer!** - If it overlaps the frame_or_window field of struct input_event, - that will cause GC to crash. */ + this structure really describes the contents. */ + struct selection_input_event { int kind; ------------------------------------------------------------ revno: 110827 committer: Michael Albinus <michael.albinus@gmx.de branch nick: trunk timestamp: Thu 2012-11-08 08:50:43 +0100 message: * os.texi (Notifications): Update descriptions of notifications-notify, notifications-close-notification and notifications-get-capabilities according to latest code changes. Add notifications-get-server-information. diff: === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2012-11-03 11:02:43 +0000 +++ doc/lispref/ChangeLog 2012-11-08 07:50:43 +0000 @@ -1,3 +1,10 @@ +2012-11-08 Michael Albinus <michael.albinus@gmx.de> + + * os.texi (Notifications): Update descriptions of + notifications-notify, notifications-close-notification and + notifications-get-capabilities according to latest code changes. + Add notifications-get-server-information. + 2012-11-03 Chong Yidong <cyd@gnu.org> * objects.texi (General Escape Syntax): Clarify the explanation of === modified file 'doc/lispref/os.texi' --- doc/lispref/os.texi 2012-10-24 05:12:23 +0000 +++ doc/lispref/os.texi 2012-11-08 07:50:43 +0000 @@ -2276,13 +2276,19 @@ The supported keywords and values are as follows: @table @code +@item :bus @var{bus} +The D-Bus bus. This argument is needed only if a bus other than +@code{:session} shall be used. + @item :title @var{title} The notification title. @item :body @var{text} The notification body text. Depending on the implementation of the notification server, the text could contain HTML markups, like -@samp{"<b>bold text</b>"}, hyperlinks, or images. +@samp{"<b>bold text</b>"}, hyperlinks, or images. Special HTML +characters must be encoded, as @samp{"Contact +<postmaster@@localhost>!"}. @item :app-name @var{name} The name of the application sending the notification. The default is @@ -2317,7 +2323,10 @@ interpreted as icon name. @item :category @var{category} -The type of notification this is, a string. +The type of notification this is, a string. See the +@uref{http://developer.gnome.org/notification-spec/#categories, +Desktop Notifications Specification} for a list of standard +categories. @item :desktop-entry @var{filename} This specifies the name of the desktop filename representing the @@ -2420,13 +2429,17 @@ @end example @end defun -@defun notifications-close-notification id +@defun notifications-close-notification id &optional bus This function closes a notification with identifier @var{id}. +@var{bus} can be a string denoting a D-Bus connection, the default is +@code{:session}. @end defun -@defun notifications-get-capabilities -Returns the capabilities of the notification server, a list of strings. -The following capabilities can be expected: +@defun notifications-get-capabilities &optional bus +Returns the capabilities of the notification server, a list of +symbols. @var{bus} can be a string denoting a D-Bus connection, the +default is @code{:session}. The following capabilities can be +expected: @table @code @item :actions @@ -2463,6 +2476,30 @@ @code{:x-gnome-foo-cap}. @end defun +@defun notifications-get-server-information &optional bus +Return information on the notification server, a list of strings. +@var{bus} can be a string denoting a D-Bus connection, the default is +@code{:session}. The returned list is @code{(@var{name} @var{vendor} +@var{version} @var{spec-version})}. + +@table @var +@item name +The product name of the server. + +@item vendor +The vendor name. For example, @samp{"KDE"}, @samp{"GNOME"}. + +@item version +The server's version number. + +@item spec-version +The specification version the server is compliant with. +@end table + +If @var{SPEC_VERSION} is @code{nil}, the server supports a +specification prior to @samp{"1.0"}. +@end defun + @node Dynamic Libraries @section Dynamically Loaded Libraries