Now on revision 112113. ------------------------------------------------------------ revno: 112113 committer: Leo Liu branch nick: trunk timestamp: Sat 2013-03-23 10:21:25 +0800 message: * lisp/nxml/nxml-util.el (nxml-with-unmodifying-text-property-changes): Remove. * lisp/nxml/rng-valid.el (rng-validate-mode) (rng-after-change-function, rng-do-some-validation): * lisp/nxml/rng-maint.el (rng-validate-buffer): * lisp/nxml/nxml-rap.el (nxml-tokenize-forward, nxml-ensure-scan-up-to-date): * lisp/nxml/nxml-outln.el (nxml-show-all, nxml-set-outline-state): * lisp/nxml/nxml-mode.el (nxml-mode, nxml-degrade, nxml-after-change) (nxml-extend-after-change-region): Use with-silent-modifications. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-03-23 01:38:56 +0000 +++ lisp/ChangeLog 2013-03-23 02:21:25 +0000 @@ -1,5 +1,16 @@ 2013-03-23 Leo Liu + * nxml/nxml-util.el (nxml-with-unmodifying-text-property-changes): + Remove. + + * nxml/rng-valid.el (rng-validate-mode) + (rng-after-change-function, rng-do-some-validation): + * nxml/rng-maint.el (rng-validate-buffer): + * nxml/nxml-rap.el (nxml-tokenize-forward, nxml-ensure-scan-up-to-date): + * nxml/nxml-outln.el (nxml-show-all, nxml-set-outline-state): + * nxml/nxml-mode.el (nxml-mode, nxml-degrade, nxml-after-change) + (nxml-extend-after-change-region): Use with-silent-modifications. + * nxml/rng-nxml.el (rng-set-state-after): Do not let-bind timer-idle-list. === modified file 'lisp/nxml/nxml-mode.el' --- lisp/nxml/nxml-mode.el 2013-02-12 17:36:54 +0000 +++ lisp/nxml/nxml-mode.el 2013-03-23 02:21:25 +0000 @@ -540,7 +540,7 @@ (widen) (nxml-clear-dependent-regions (point-min) (point-max)) (setq nxml-scan-end (copy-marker (point-min) nil)) - (nxml-with-unmodifying-text-property-changes + (with-silent-modifications (nxml-clear-inside (point-min) (point-max)) (nxml-with-invisible-motion (nxml-scan-prolog))))) @@ -601,7 +601,7 @@ (save-excursion (save-restriction (widen) - (nxml-with-unmodifying-text-property-changes + (with-silent-modifications (nxml-clear-inside (point-min) (point-max)))))) ;;; Change management @@ -625,7 +625,7 @@ (widen) (save-match-data (nxml-with-invisible-motion - (nxml-with-unmodifying-text-property-changes + (with-silent-modifications (nxml-after-change1 start end pre-change-length))))))))) @@ -910,7 +910,7 @@ (widen) (save-match-data (nxml-with-invisible-motion - (nxml-with-unmodifying-text-property-changes + (with-silent-modifications (nxml-extend-after-change-region1 start end pre-change-length))))))))) (if (consp region) region)))) === modified file 'lisp/nxml/nxml-outln.el' --- lisp/nxml/nxml-outln.el 2013-01-01 09:11:05 +0000 +++ lisp/nxml/nxml-outln.el 2013-03-23 02:21:25 +0000 @@ -149,7 +149,7 @@ (defun nxml-show-all () "Show all elements in the buffer normally." (interactive) - (nxml-with-unmodifying-text-property-changes + (with-silent-modifications (remove-text-properties (point-min) (point-max) '(nxml-outline-state nil))) @@ -370,7 +370,7 @@ (get-text-property pos 'nxml-outline-state)) (defun nxml-set-outline-state (pos state) - (nxml-with-unmodifying-text-property-changes + (with-silent-modifications (if state (put-text-property pos (1+ pos) 'nxml-outline-state state) (remove-text-properties pos (1+ pos) '(nxml-outline-state nil))))) === modified file 'lisp/nxml/nxml-rap.el' --- lisp/nxml/nxml-rap.el 2013-01-01 09:11:05 +0000 +++ lisp/nxml/nxml-rap.el 2013-03-23 02:21:25 +0000 @@ -293,7 +293,7 @@ (cond ((memq xmltok-type '(comment cdata-section processing-instruction)) - (nxml-with-unmodifying-text-property-changes + (with-silent-modifications (nxml-set-inside (1+ xmltok-start) (point) xmltok-type))) (xmltok-dependent-regions (nxml-mark-parse-dependent-regions))) @@ -338,7 +338,7 @@ '(comment processing-instruction cdata-section)) - (nxml-with-unmodifying-text-property-changes + (with-silent-modifications (nxml-set-inside (1+ xmltok-start) (point) xmltok-type))) === modified file 'lisp/nxml/nxml-util.el' --- lisp/nxml/nxml-util.el 2013-01-01 09:11:05 +0000 +++ lisp/nxml/nxml-util.el 2013-03-23 02:21:25 +0000 @@ -78,27 +78,6 @@ (nxml-degrade ,context ,error-symbol)))) `(progn ,@body))) -(defmacro nxml-with-unmodifying-text-property-changes (&rest body) - "Evaluate BODY without any text property changes modifying the buffer. -Any text properties changes happen as usual but the changes are not treated as -modifications to the buffer." - (let ((modified (make-symbol "modified"))) - `(let ((,modified (buffer-modified-p)) - (inhibit-read-only t) - (inhibit-modification-hooks t) - (buffer-undo-list t) - (deactivate-mark nil) - ;; Apparently these avoid file locking problems. - (buffer-file-name nil) - (buffer-file-truename nil)) - (unwind-protect - (progn ,@body) - (unless ,modified - (restore-buffer-modified-p nil)))))) - -(put 'nxml-with-unmodifying-text-property-changes 'lisp-indent-function 0) -(def-edebug-spec nxml-with-unmodifying-text-property-changes t) - (defmacro nxml-with-invisible-motion (&rest body) "Evaluate body without calling any point motion hooks." `(let ((inhibit-point-motion-hooks t)) === modified file 'lisp/nxml/rng-maint.el' --- lisp/nxml/rng-maint.el 2013-01-01 09:11:05 +0000 +++ lisp/nxml/rng-maint.el 2013-03-23 02:21:25 +0000 @@ -259,7 +259,7 @@ (defun rng-validate-buffer () (save-restriction (widen) - (nxml-with-unmodifying-text-property-changes + (with-silent-modifications (rng-clear-cached-state (point-min) (point-max))) ;; 1+ to clear empty overlays at (point-max) (rng-clear-overlays (point-min) (1+ (point-max)))) === modified file 'lisp/nxml/rng-valid.el' --- lisp/nxml/rng-valid.el 2013-03-23 01:38:56 +0000 +++ lisp/nxml/rng-valid.el 2013-03-23 02:21:25 +0000 @@ -244,7 +244,7 @@ (> (prefix-numeric-value arg) 0))) (save-restriction (widen) - (nxml-with-unmodifying-text-property-changes + (with-silent-modifications (rng-clear-cached-state (point-min) (point-max))) ;; 1+ to clear empty overlays at (point-max) (rng-clear-overlays (point-min) (1+ (point-max))) @@ -305,7 +305,7 @@ (defun rng-after-change-function (start end pre-change-len) (setq rng-message-overlay-inhibit-point nil) - (nxml-with-unmodifying-text-property-changes + (with-silent-modifications (rng-clear-cached-state start end)) ;; rng-validate-up-to-date-end holds the position before the change ;; Adjust it to reflect the change. @@ -469,7 +469,7 @@ (condition-case-unless-debug err (and (rng-validate-prepare) (let ((rng-dt-namespace-context-getter '(nxml-ns-get-context))) - (nxml-with-unmodifying-text-property-changes + (with-silent-modifications (rng-do-some-validation-1 continue-p-function)))) ;; errors signaled from a function run by an idle timer ;; are ignored; if we don't catch them, validation ------------------------------------------------------------ revno: 112112 fixes bug: http://debbugs.gnu.org/13999 committer: Leo Liu branch nick: trunk timestamp: Sat 2013-03-23 09:38:56 +0800 message: * lisp/nxml/rng-nxml.el (rng-set-state-after): Do not let-bind timer-idle-list. * lisp/nxml/rng-valid.el (rng-validate-while-idle-continue-p) (rng-next-error-1, rng-previous-error-1): Do not let-bind timer-idle-list. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-03-23 00:38:11 +0000 +++ lisp/ChangeLog 2013-03-23 01:38:56 +0000 @@ -1,3 +1,12 @@ +2013-03-23 Leo Liu + + * nxml/rng-nxml.el (rng-set-state-after): Do not let-bind + timer-idle-list. + + * nxml/rng-valid.el (rng-validate-while-idle-continue-p) + (rng-next-error-1, rng-previous-error-1): Do not let-bind + timer-idle-list. (Bug#13999) + 2013-03-23 Juri Linkov * info.el (info-index-match): New face. === modified file 'lisp/nxml/rng-nxml.el' --- lisp/nxml/rng-nxml.el 2013-01-01 09:11:05 +0000 +++ lisp/nxml/rng-nxml.el 2013-03-23 01:38:56 +0000 @@ -380,9 +380,7 @@ (< rng-validate-up-to-date-end pos)) ;; Display percentage validated. (force-mode-line-update) - ;; Force redisplay but don't allow idle timers to run. - (let ((timer-idle-list nil)) - (sit-for 0))) + (sit-for 0)) (message "Parsing...done")) (save-excursion (save-restriction === modified file 'lisp/nxml/rng-valid.el' --- lisp/nxml/rng-valid.el 2013-01-01 09:11:05 +0000 +++ lisp/nxml/rng-valid.el 2013-03-23 01:38:56 +0000 @@ -414,26 +414,17 @@ (defvar rng-validate-display-modified-p nil) (defun rng-validate-while-idle-continue-p () - ;; input-pending-p and sit-for run timers that are - ;; ripe. Binding timer-idle-list to nil prevents - ;; this. If we don't do this, then any ripe timers - ;; will get run, and we won't get any chance to - ;; validate until Emacs becomes idle again or until - ;; the other lower priority timers finish (which - ;; can take a very long time in the case of - ;; jit-lock). - (let ((timer-idle-list nil)) - (and (not (input-pending-p)) - ;; Fake rng-validate-up-to-date-end so that the mode line - ;; shows progress. Also use this to save point. - (let ((rng-validate-up-to-date-end (point))) - (goto-char rng-validate-display-point) - (when (not rng-validate-display-modified-p) - (restore-buffer-modified-p nil)) - (force-mode-line-update) - (let ((continue (sit-for 0))) - (goto-char rng-validate-up-to-date-end) - continue))))) + (and (not (input-pending-p)) + ;; Fake rng-validate-up-to-date-end so that the mode line + ;; shows progress. Also use this to save point. + (let ((rng-validate-up-to-date-end (point))) + (goto-char rng-validate-display-point) + (when (not rng-validate-display-modified-p) + (restore-buffer-modified-p nil)) + (force-mode-line-update) + (let ((continue (sit-for 0))) + (goto-char rng-validate-up-to-date-end) + continue)))) ;; Calling rng-do-some-validation once with a continue-p function, as ;; opposed to calling it repeatedly, helps on initial validation of a @@ -880,9 +871,7 @@ (< rng-validate-up-to-date-end (point-max))) ;; Display percentage validated. (force-mode-line-update) - ;; Force redisplay but don't allow idle timers to run. - (let ((timer-idle-list nil)) - (sit-for 0)) + (sit-for 0) (setq pos (max pos (1- rng-validate-up-to-date-end))) t))))) @@ -905,9 +894,7 @@ (while (and (rng-do-some-validation) (< rng-validate-up-to-date-end (min pos (point-max)))) (force-mode-line-update) - ;; Force redisplay but don't allow idle timers to run. - (let ((timer-idle-list nil)) - (sit-for 0))) + (sit-for 0)) (while (and (> arg 0) (setq err (rng-find-previous-error-overlay pos))) (setq pos (overlay-start err)) ------------------------------------------------------------ revno: 112111 fixes bug: http://debbugs.gnu.org/14015 committer: Juri Linkov branch nick: trunk timestamp: Sat 2013-03-23 02:38:11 +0200 message: * lisp/info.el (info-index-match): New face. (Info-index, Info-apropos-matches): Add a nested subgroup to the main pattern and add text properties with the new face to matches in index entries relative to the beginning of the index entry. diff: === modified file 'etc/NEWS' --- etc/NEWS 2013-03-12 02:08:21 +0000 +++ etc/NEWS 2013-03-23 00:38:11 +0000 @@ -174,6 +174,12 @@ It also has an optional frame argument, which can be used by Lisp callers to fit the image to a frame other than the selected frame. +** Info + +*** New face `info-index-match' is used to highlight matches in index +entries displayed by `Info-index-next', `Info-virtual-index' and +`info-apropos'. + ** Isearch *** `C-x 8 RET' in Isearch mode reads a character by its Unicode name === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-03-22 19:31:15 +0000 +++ lisp/ChangeLog 2013-03-23 00:38:11 +0000 @@ -1,3 +1,11 @@ +2013-03-23 Juri Linkov + + * info.el (info-index-match): New face. + (Info-index, Info-apropos-matches): Add a nested subgroup to the + main pattern and add text properties with the new face to matches + in index entries relative to the beginning of the index entry. + (Bug#14015) + 2013-03-21 Eric Ludlam * eieio/eieio-datadebug.el (data-debug/eieio-insert-slots): === modified file 'lisp/info.el' --- lisp/info.el 2013-03-20 23:04:40 +0000 +++ lisp/info.el 2013-03-23 00:38:11 +0000 @@ -158,6 +158,12 @@ "Face for Info nodes in a node header." :group 'info) +(defface info-index-match + '((t :inherit match)) + "Face used to highlight matches in an index entry." + :group 'info + :version "24.4") + ;; This is a defcustom largely so that we can get the benefit ;; of custom-initialize-delay. Perhaps it would work to make it a ;; defvar and explicitly give it a standard-value property, and @@ -3063,15 +3069,15 @@ is searched using the text property PROP. Move point to the closest found position of either a cross-reference found by `re-search-forward' or a link found by `next-single-char-property-change'. Return the new position of point, or nil." - (let ((pcref (save-excursion (re-search-forward pat nil t))) + (let ((pxref (save-excursion (re-search-forward pat nil t))) (plink (next-single-char-property-change (point) prop))) (when (and (< plink (point-max)) (not (get-char-property plink prop))) (setq plink (next-single-char-property-change plink prop))) (if (< plink (point-max)) - (if (and pcref (<= pcref plink)) + (if (and pxref (<= pxref plink)) (goto-char (or (match-beginning 1) (match-beginning 0))) (goto-char plink)) - (if pcref (goto-char (or (match-beginning 1) (match-beginning 0))))))) + (if pxref (goto-char (or (match-beginning 1) (match-beginning 0))))))) (defun Info-prev-reference-or-link (pat prop) "Move point to the previous pattern-based cross-reference or property-based link. @@ -3079,15 +3085,15 @@ is searched using the text property PROP. Move point to the closest found position of either a cross-reference found by `re-search-backward' or a link found by `previous-single-char-property-change'. Return the new position of point, or nil." - (let ((pcref (save-excursion (re-search-backward pat nil t))) + (let ((pxref (save-excursion (re-search-backward pat nil t))) (plink (previous-single-char-property-change (point) prop))) (when (and (> plink (point-min)) (not (get-char-property plink prop))) (setq plink (previous-single-char-property-change plink prop))) (if (> plink (point-min)) - (if (and pcref (>= pcref plink)) + (if (and pxref (>= pxref plink)) (goto-char (or (match-beginning 1) (match-beginning 0))) (goto-char plink)) - (if pcref (goto-char (or (match-beginning 1) (match-beginning 0))))))) + (if pxref (goto-char (or (match-beginning 1) (match-beginning 0))))))) (defun Info-next-reference (&optional recur count) "Move cursor to the next cross-reference or menu item in the node. @@ -3276,7 +3282,7 @@ (= (aref topic 0) ?:)) (setq topic (substring topic 1))) (let ((orignode Info-current-node) - (pattern (format "\n\\* +\\([^\n]*%s[^\n]*\\):[ \t]+\\([^\n]*\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?" + (pattern (format "\n\\* +\\([^\n]*\\(%s\\)[^\n]*\\):[ \t]+\\([^\n]*\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?" (regexp-quote topic))) node (nodes (Info-index-nodes)) (ohist-list Info-history-list) @@ -3295,12 +3301,14 @@ (progn (goto-char (point-min)) (while (re-search-forward pattern nil t) - (push (list (match-string-no-properties 1) - (match-string-no-properties 2) - Info-current-node - (string-to-number (concat "0" - (match-string 3)))) - matches)) + (let ((entry (match-string-no-properties 1)) + (nodename (match-string-no-properties 3)) + (line (string-to-number (concat "0" (match-string 4))))) + (add-text-properties + (- (match-beginning 2) (match-beginning 1)) + (- (match-end 2) (match-beginning 1)) + '(face info-index-match) entry) + (push (list entry nodename Info-current-node line) matches))) (setq nodes (cdr nodes) node (car nodes))) (Info-goto-node node)) (or matches @@ -3526,7 +3534,7 @@ Return a list of matches where each element is in the format \((FILENAME INDEXTEXT NODENAME LINENUMBER))." (unless (string= string "") - (let ((pattern (format "\n\\* +\\([^\n]*%s[^\n]*\\):[ \t]+\\([^\n]+\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?" + (let ((pattern (format "\n\\* +\\([^\n]*\\(%s\\)[^\n]*\\):[ \t]+\\([^\n]+\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?" (regexp-quote string))) (ohist Info-history) (ohist-list Info-history-list) @@ -3559,12 +3567,15 @@ (progn (goto-char (point-min)) (while (re-search-forward pattern nil t) - (setq matches - (cons (list manual - (match-string-no-properties 1) - (match-string-no-properties 2) - (match-string-no-properties 3)) - matches))) + (let ((entry (match-string-no-properties 1)) + (nodename (match-string-no-properties 3)) + (line (match-string-no-properties 4))) + (add-text-properties + (- (match-beginning 2) (match-beginning 1)) + (- (match-end 2) (match-beginning 1)) + '(face info-index-match) entry) + (setq matches (cons (list manual entry nodename line) + matches)))) (setq nodes (cdr nodes) node (car nodes))) (Info-goto-node node)))) (error ------------------------------------------------------------ revno: 112110 [merge] committer: David Engster branch nick: trunk timestamp: Fri 2013-03-22 20:31:15 +0100 message: Merge with CEDET upstream (rev. 8499). diff: === modified file 'etc/ChangeLog' --- etc/ChangeLog 2013-03-18 05:26:56 +0000 +++ etc/ChangeLog 2013-03-22 19:31:15 +0000 @@ -1,3 +1,19 @@ +2013-03-21 Eric Ludlam + + * srecode/ede-autoconf.srt: Change Copyright to FSF. + (ede-empty): Change AC_INIT to use PROJECT_NAME, and + PROJECT_VERSION. + + * srecode/ede-make.srt (ede-empty): Add a dependency on :project. + Add header comment specifying the project's relative path. + + * srecode/c.srt (header_guard): Upcase the filename symbol. + +2013-03-21 Vladimir Kazanov + + * srecode/java.srt (empty-main): New. + (class-tag): Decapitalize class. + 2013-03-18 Paul Eggert Emacs crashes with ImageMagick 6.8.2-3 through 6.8.3-9 (Bug#13867). === modified file 'etc/srecode/c.srt' --- etc/srecode/c.srt 2013-01-01 09:11:05 +0000 +++ etc/srecode/c.srt 2013-03-21 22:11:03 +0000 @@ -46,12 +46,12 @@ template header_guard :file :blank ---- -#ifndef {{FILENAME_SYMBOL}} -#define {{FILENAME_SYMBOL}} 1 +#ifndef {{FILENAME_SYMBOL:upcase}} +#define {{FILENAME_SYMBOL:upcase}} 1 {{^}} -#endif // {{FILENAME_SYMBOL}} +#endif // {{FILENAME_SYMBOL:upcase}} ---- context misc === modified file 'etc/srecode/ede-autoconf.srt' --- etc/srecode/ede-autoconf.srt 2012-12-31 15:34:32 +0000 +++ etc/srecode/ede-autoconf.srt 2013-03-21 22:11:03 +0000 @@ -1,6 +1,6 @@ ;; ede/templates/autoconf.srt --- Templates for autoconf used by EDE. ;; -;; Copyright (C) 2010 Eric M. Ludlam +;; Copyright (C) 2010, 2013 Free Software Foundation, Inc. ;; ;; Author: Eric M. Ludlam ;; @@ -26,7 +26,7 @@ context file -template ede-empty +template ede-empty :project "Start a new EDE generated configure.in/ac file." ---- {{comment_prefix}} Automatically Generated/Maintained {{FILE}} by EDE. @@ -40,7 +40,7 @@ {{comment_prefix}} {{comment_prefix}} Process this file with autoconf to produce a configure script -AC_INIT({{TEST_FILE}}) +AC_INIT({{PROJECT_NAME}}, {{PROJECT_VERSION}}) AM_INIT_AUTOMAKE([{{PROGRAM}}], 0) AM_CONFIG_HEADER(config.h) === modified file 'etc/srecode/ede-make.srt' --- etc/srecode/ede-make.srt 2013-01-01 09:11:05 +0000 +++ etc/srecode/ede-make.srt 2013-03-21 22:11:03 +0000 @@ -26,10 +26,11 @@ context file -template ede-empty :file +template ede-empty :file :project ---- # Automatically Generated {{FILE}} by EDE. # For use with: {{MAKETYPE}} +# Relative File Name: {{PROJECT_FILENAME}} # # DO NOT MODIFY THIS FILE OR YOUR CHANGES MAY BE LOST. # EDE is the Emacs Development Environment. === modified file 'etc/srecode/java.srt' --- etc/srecode/java.srt 2013-01-01 09:11:05 +0000 +++ etc/srecode/java.srt 2013-03-21 22:11:03 +0000 @@ -43,6 +43,23 @@ ---- bind "e" +template empty-main :file :user :time :java :indent +"Fill out an empty file with a class having a static main method" +sectiondictionary "CLASSSECTION" +set NAME macro "FILENAME_AS_CLASS" +---- +{{>:filecomment}} + +package {{FILENAME_AS_PACKAGE}}; + +{{:declaration:javadoc-class}} -public Class {{?NAME}} {{#PARENTS}}{{#FIRST}}extends {{/FIRST}}{{#NOTFIRST}}implements {{/NOTFIRST}}{{NAME}}{{/PARENTS}} -{ +public class {{?NAME}} {{#PARENTS}}{{#FIRST}}extends {{/FIRST}}{{#NOTFIRST}}implements {{/NOTFIRST}}{{NAME}}{{/PARENTS}} +{ {{^}} }; ---- === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-03-22 19:06:53 +0000 +++ lisp/ChangeLog 2013-03-22 19:31:15 +0000 @@ -1,3 +1,8 @@ +2013-03-21 Eric Ludlam + + * eieio/eieio-datadebug.el (data-debug/eieio-insert-slots): + Inhibit read only while inserting objects. + 2013-03-22 Teodor Zlatanov * progmodes/cfengine.el: Update docs to mention === modified file 'lisp/cedet/ChangeLog' --- lisp/cedet/ChangeLog 2013-03-11 16:31:55 +0000 +++ lisp/cedet/ChangeLog 2013-03-21 22:11:03 +0000 @@ -1,3 +1,175 @@ +2013-03-21 Eric Ludlam + + * semantic.el (navigate-menu): Yank Tag :enable. Make sure + `senator-tag-ring' is bound. + (semantic-parse-region-default): Stop reversing the output of + parse-whole-stream. + (semantic-repeat-parse-whole-stream): Append returned tags + differently, so they come out in the right order. + + * semantic/sb.el (semantic-sb-filter-tags-of-class): New option. + (semantic-sb-fetch-tag-table): Filter tags being bucketed to + exclude tags belonging to above filtered classes. + + * semantic/find.el (semantic-filter-tags-by-class): New function. + + * semantic/tag-ls.el (semantic-tag-similar-p-default): Add + short-circuit in case tag1 and 2 are identical. + + * semantic/analyze/fcn.el + (semantic-analyze-dereference-metatype-stack): Use + `semantic-tag-similar-p' instead of 'eq' when comparing two tags + during metatype evaluation in case they are the same, but not the + same node. (Tweaked patch from Tomasz Gajewski) (Tiny change) + + * semantic/db-find.el (semanticdb-partial-synchronize): Fix + require to semantic/db-typecache to be correct. + (semanticdb-find-tags-external-children-of-type): Make this a + brutish search by default. + + * semantic/sort.el + (semantic-tag-external-member-children-default): When calling + `semanticdb-find-tags-external-children-of-type', pass in the + input tag as the place to start searching for externally defined + methods. + + * semantic/db-file.el (semanticdb-default-save-directory): Doc + fix: Add ref to default value. + + * semantic/complete.el (semantic-complete-post-command-hook): When + detecting if cursor is outside completion area, do so if cursor + moves before start of overlay, or the original starting location + of the overlay (i.e., if user deletes past beginning of the + overlay region). + (semantic-complete-inline-tag-engine): Initialize original start + of `semantic-complete-inline-overlay'. + + * semantic/bovine/c.el (semantic-c-describe-environment): Update + some section titles. Test semanticdb table before printing it. + (semantic-c-reset-preprocessor-symbol-map): Update + `semantic-lex-spp-macro-symbol-obarray' outside the loop over all + the files contributing to its value. + (semantic-c-describe-environment): If there is an EDE project but + no spp symbols from it, say so. + + * srecode/args.el (srecode-semantic-handle-:project): New argument + handler. Provide variable values if not in an EDE project. + + * srecode/srt-mode.el (srecode-template-mode): Fix typo on srecode + name. + + * srecode/cpp.el (srecode-semantic-handle-:c): Replace all + characters in FILENAME_SYMBOL that aren't valid CPP symbol chars. + + * srecode/map.el (srecode-map-validate-file-for-mode): Force + semantic to load if it is not active in the template being added + to the map. + + * srecode/srt.el: Add local variables for setting the autoload + file name. + (srecode-semantic-handle-:srt): New autoload cookie + + * ede.el (ede-apply-preprocessor-map): Apply map to + `semantic-lex-spp-project-macro-symbol-obarray' instead of the + system one. Add require for semantic. + + * ede/proj-elisp.el (ede-update-version-in-source): In case a file + has both a version variable and a Version: comment, always use + `call-next-method'. + + * ede/cpp-root.el (ede-set-project-variables): Deleted. + `ede-preprocessor-map' does the job this function was attempting + to do with :spp-table. + (ede-preprocessor-map): Update file tests to provide better + messages. Do not try to get symbols from a file that is the file + in the current buffer. + + * ede/base.el (ede-project-placeholder): Add more documentation to + :file slot. + (ede-load-cache): Use `insert-file-contents' instead of + `find-file-noselect' in order to avoid activating other tools. + +2013-03-21 David Engster + + * semantic/bovine/c.el (semantic-get-local-variables): Also add a + new variable 'this' if we are in an inline member function. For + detecting this, we check overlays at point if there is a class + spanning the current function. Also, the variable 'this' has to + be a pointer. + + * semantic/bovine/gcc.el (semantic-gcc-setup): Fail gracefully + when querying g++ for defines returns an error. + + * srecode/srt-mode.el: + * srecode/compile.el: + * semantic/elp.el: + * semantic/db-el.el: + * semantic/complete.el: + * ede.el: + * cogre.el: + * srecode/table.el: + * srecode/mode.el: + * srecode/insert.el: + * srecode/compile.el: + * semantic/decorate/include.el: + * semantic/db.el: + * semantic/adebug.el: + * ede/auto.el: + * srecode/dictionary.el: + * semantic/ede-grammar.el: + * semantic/db.el: + * semantic/db-find.el: + * semantic/db-file.el: + * semantic/complete.el: + * semantic/bovine/c.el: + * semantic/analyze.el: + * ede/util.el: + * ede/proj.el: + * ede/proj-elisp.el: + * ede/pconf.el: + * ede/locate.el: + * ede.el: Adapt to EIEIO namespace cleanup: Rename `object-name' + to `eieio-object-name', `object-set-name-string' to + `eieio-object-set-name-string', `object-class' to + `eieio-object-class', `class-parent' to `eieio-class-parent', + `class-parents' to `eieio-class-parents', `class-children' to + `eieio-class-children', `object-name-string' to + `eieio-object-name-string', `object-class-fast' to + `eieio--object-class'. Also replace direct access with new + accessor functions. + +2013-03-21 Tomasz Gajewski (tiny change) + + * ede/cpp-root.el (ede-project-autoload, initialize-instance): Fix + EDE file symbol to match rename. Fix ede-cpp-root symbol to + include -project in name. + +2013-03-21 Alex Ott + + * cedet-files.el (cedet-files-list-recursively): New. Recursively + find files whose names are matching to given regex + + * ede.el (ede-current-project): Rewrite to avoid imperative style. + + * ede/files.el (ede-find-file): Simplify code. + + * ede/base.el (ede-normalize-file/directory): Add function to + normalize :file or :directory slots if they are missing. + + * ede/cpp-root.el (ede-cpp-root-project): Add compile-command + slot. + (project-compile-project): Compiles project using value specified + in :compule-command slot or in compile-command local variable. + Value of slot or local variable could be string or function that + receives project and should return string that will be invoked as + command. + (project-compile-target): Invokes compilation of whole project + + * ede/files.el (ede-find-project-root): New function to + find root of project that contains specific file. + (ede-files-find-existing): New function which checks presence of + given directory in the list of registered projects. + 2013-03-04 Paul Eggert * semantic/wisent/wisent.el (wisent): Stick to ASCII in the ASCII art. === modified file 'lisp/cedet/cedet-files.el' --- lisp/cedet/cedet-files.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/cedet-files.el 2013-03-21 22:11:03 +0000 @@ -88,6 +88,24 @@ (setq file (concat "//" (substring file 1))))) file)) +(defun cedet-files-list-recursively (dir re) + "Returns list of files in directory matching to given regex" + (when (file-accessible-directory-p dir) + (let ((files (directory-files dir t)) + matched) + (dolist (file files matched) + (let ((fname (file-name-nondirectory file))) + (cond + ((or (string= fname ".") + (string= fname "..")) nil) + ((and (file-regular-p file) + (string-match re fname)) + (setq matched (cons file matched))) + ((file-directory-p file) + (let ((tfiles (cedet-files-list-recursively file re))) + (when tfiles (setq matched (append matched tfiles))))))))))) + + (provide 'cedet-files) ;;; cedet-files.el ends here === modified file 'lisp/cedet/ede.el' --- lisp/cedet/ede.el 2013-01-31 19:58:56 +0000 +++ lisp/cedet/ede.el 2013-03-21 22:11:03 +0000 @@ -330,14 +330,14 @@ (easy-menu-create-menu "Project Forms" (let* ((obj (ede-current-project)) - (class (if obj (object-class obj))) + (class (if obj (eieio-object-class obj))) (menu nil)) (condition-case err (progn (while (and class (slot-exists-p class 'menu)) ;;(message "Looking at class %S" class) (setq menu (append menu (oref class menu)) - class (class-parent class)) + class (eieio-class-parent class)) (if (listp class) (setq class (car class)))) (append '( [ "Add Target" ede-new-target (ede-current-project) ] @@ -382,7 +382,7 @@ (oref proj configuration-default))))) (oset (ede-current-project) configuration-default newconfig) (message "%s will now build in %s mode." - (object-name (ede-current-project)) + (eieio-object-name (ede-current-project)) newconfig)) (defun ede-customize-forms-menu (menu-def) @@ -727,7 +727,7 @@ 'name (let* ((l ede-project-class-files) (cp (ede-current-project)) - (cs (when cp (object-class cp))) + (cs (when cp (eieio-object-class cp))) (r nil)) (while l (if cs @@ -779,7 +779,7 @@ :targets nil))) (inits (oref obj initializers))) ;; Force the name to match for new objects. - (object-set-name-string nobj (oref nobj :name)) + (eieio-object-set-name-string nobj (oref nobj :name)) ;; Handle init args. (while inits (eieio-oset nobj (car inits) (car (cdr inits))) @@ -885,7 +885,7 @@ (when (not ede-object) (error "Can't add %s to target %s: Wrong file type" (file-name-nondirectory (buffer-file-name)) - (object-name target))) + (eieio-object-name target))) (ede-apply-target-options)) (defun ede-remove-file (&optional force) @@ -979,12 +979,12 @@ (defmethod project-add-file ((ot ede-target) file) "Add the current buffer into project project target OT. Argument FILE is the file to add." - (error "add-file not supported by %s" (object-name ot))) + (error "add-file not supported by %s" (eieio-object-name ot))) (defmethod project-remove-file ((ot ede-target) fnnd) "Remove the current buffer from project target OT. Argument FNND is an argument." - (error "remove-file not supported by %s" (object-name ot))) + (error "remove-file not supported by %s" (eieio-object-name ot))) (defmethod project-edit-file-target ((ot ede-target)) "Edit the target OT associated with this file." @@ -992,45 +992,45 @@ (defmethod project-new-target ((proj ede-project) &rest args) "Create a new target. It is up to the project PROJ to get the name." - (error "new-target not supported by %s" (object-name proj))) + (error "new-target not supported by %s" (eieio-object-name proj))) (defmethod project-new-target-custom ((proj ede-project)) "Create a new target. It is up to the project PROJ to get the name." - (error "New-target-custom not supported by %s" (object-name proj))) + (error "New-target-custom not supported by %s" (eieio-object-name proj))) (defmethod project-delete-target ((ot ede-target)) "Delete the current target OT from its parent project." - (error "add-file not supported by %s" (object-name ot))) + (error "add-file not supported by %s" (eieio-object-name ot))) (defmethod project-compile-project ((obj ede-project) &optional command) "Compile the entire current project OBJ. Argument COMMAND is the command to use when compiling." - (error "compile-project not supported by %s" (object-name obj))) + (error "compile-project not supported by %s" (eieio-object-name obj))) (defmethod project-compile-target ((obj ede-target) &optional command) "Compile the current target OBJ. Argument COMMAND is the command to use for compiling the target." - (error "compile-target not supported by %s" (object-name obj))) + (error "compile-target not supported by %s" (eieio-object-name obj))) (defmethod project-debug-target ((obj ede-target)) "Run the current project target OBJ in a debugger." - (error "debug-target not supported by %s" (object-name obj))) + (error "debug-target not supported by %s" (eieio-object-name obj))) (defmethod project-run-target ((obj ede-target)) "Run the current project target OBJ." - (error "run-target not supported by %s" (object-name obj))) + (error "run-target not supported by %s" (eieio-object-name obj))) (defmethod project-make-dist ((this ede-project)) "Build a distribution for the project based on THIS project." - (error "Make-dist not supported by %s" (object-name this))) + (error "Make-dist not supported by %s" (eieio-object-name this))) (defmethod project-dist-files ((this ede-project)) "Return a list of files that constitute a distribution of THIS project." - (error "Dist-files is not supported by %s" (object-name this))) + (error "Dist-files is not supported by %s" (eieio-object-name this))) (defmethod project-rescan ((this ede-project)) "Rescan the EDE project THIS." - (error "Rescanning a project is not supported by %s" (object-name this))) + (error "Rescanning a project is not supported by %s" (eieio-object-name this))) (defun ede-ecb-project-paths () "Return a list of all paths for all active EDE projects. @@ -1157,18 +1157,15 @@ (defun ede-current-project (&optional dir) "Return the current project file. If optional DIR is provided, get the project for DIR instead." - (let ((ans nil)) - ;; If it matches the current directory, do we have a pre-existing project? - (when (and (or (not dir) (string= dir default-directory)) - ede-object-project) - (setq ans ede-object-project) - ) + ;; If it matches the current directory, do we have a pre-existing project? + (let ((proj (when (and (or (not dir) (string= dir default-directory)) + ede-object-project) + ede-object-project))) ;; No current project. - (when (not ans) + (if proj + proj (let* ((ldir (or dir default-directory))) - (setq ans (ede-directory-get-open-project ldir)))) - ;; Return what we found. - ans)) + (ede-directory-get-open-project ldir))))) (defun ede-buffer-object (&optional buffer projsym) "Return the target object for BUFFER. @@ -1372,20 +1369,24 @@ ;; C/C++ (defun ede-apply-preprocessor-map () "Apply preprocessor tables onto the current buffer." + ;; TODO - what if semantic-mode isn't enabled? + ;; what if we never want to load a C mode? Does this matter? + ;; Note: This require is needed for the case where EDE ends up + ;; in the hook order before Semantic based hooks. + (require 'semantic/lex-spp) (when (and ede-object - (boundp 'semantic-lex-spp-macro-symbol-obarray) - semantic-lex-spp-macro-symbol-obarray) + (boundp 'semantic-lex-spp-project-macro-symbol-obarray)) (let* ((objs ede-object) (map (ede-preprocessor-map (if (consp objs) (car objs) objs)))) (when map ;; We can't do a require for the below symbol. - (setq semantic-lex-spp-macro-symbol-obarray + (setq semantic-lex-spp-project-macro-symbol-obarray (semantic-lex-make-spp-table map))) (when (consp objs) (message "Choosing preprocessor syms for project %s" - (object-name (car objs))))))) + (eieio-object-name (car objs))))))) (defmethod ede-system-include-path ((this ede-project)) "Get the system include path used by project THIS." === modified file 'lisp/cedet/ede/auto.el' --- lisp/cedet/ede/auto.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/ede/auto.el 2013-03-21 22:11:03 +0000 @@ -199,8 +199,8 @@ front of the list so more generic projects don't get priority." ;; First, can we identify PROJAUTO as already in the list? If so, replace. (let ((projlist ede-project-class-files) - (projname (object-name-string projauto))) - (while (and projlist (not (string= (object-name-string (car projlist)) projname))) + (projname (eieio-object-name-string projauto))) + (while (and projlist (not (string= (eieio-object-name-string (car projlist)) projname))) (setq projlist (cdr projlist))) (if projlist === modified file 'lisp/cedet/ede/base.el' --- lisp/cedet/ede/base.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/ede/base.el 2013-03-21 22:11:03 +0000 @@ -135,7 +135,9 @@ (dirinode :documentation "The inode id for :directory.") (file :type string :initarg :file - :documentation "File name where this project is stored.") + :documentation "The File uniquely tagging this project instance. +For some project types, this will be the file that stores the project configuration. +In other projects types, this file is merely a unique identifier to this type of project.") (rootproject ; :initarg - no initarg, don't save this slot! :initform nil :type (or null ede-project-placeholder-child) @@ -350,12 +352,12 @@ (defun ede-load-cache () "Load the cache of EDE projects." (save-excursion - (let ((cachebuffer nil)) + (let ((cachebuffer (get-buffer-create "*ede cache*"))) (condition-case nil - (progn - (setq cachebuffer - (find-file-noselect ede-project-placeholder-cache-file t)) - (set-buffer cachebuffer) + (with-current-buffer cachebuffer + (erase-buffer) + (when (file-exists-p ede-project-placeholder-cache-file) + (insert-file-contents ede-project-placeholder-cache-file)) (goto-char (point-min)) (let ((c (read (current-buffer))) (new nil) @@ -610,6 +612,28 @@ cp))))) +;;; Utility functions +;; + +(defun ede-normalize-file/directory (this project-file-name) + "Fills :directory or :file slots if they're missing in project THIS. +The other slot will be used to calculate values. +PROJECT-FILE-NAME is a name of project file (short name, like 'pom.xml', etc." + (when (and (or (not (slot-boundp this :file)) + (not (oref this :file))) + (slot-boundp this :directory) + (oref this :directory)) + (oset this :file (expand-file-name project-file-name (oref this :directory)))) + (when (and (or (not (slot-boundp this :directory)) + (not (oref this :directory))) + (slot-boundp this :file) + (oref this :file)) + (oset this :directory (file-name-directory (oref this :file)))) + ) + + + + ;;; Hooks & Autoloads ;; ;; These let us watch various activities, and respond appropriately. === modified file 'lisp/cedet/ede/cpp-root.el' --- lisp/cedet/ede/cpp-root.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/ede/cpp-root.el 2013-03-21 22:11:03 +0000 @@ -242,11 +242,11 @@ (ede-add-project-autoload (ede-project-autoload "cpp-root" :name "CPP ROOT" - :file 'ede-cpp-root + :file 'ede/cpp-root :proj-file 'ede-cpp-root-project-file-for-dir :proj-root 'ede-cpp-root-project-root :load-type 'ede-cpp-root-load - :class-sym 'ede-cpp-root + :class-sym 'ede-cpp-root-project :new-p nil :safe-p t) ;; When a user creates one of these, it should override any other project @@ -272,10 +272,12 @@ ;; level include paths, and PreProcessor macro tables. (defclass ede-cpp-root-target (ede-target) - () + ((project :initform nil + :initarg :project)) "EDE cpp-root project target. All directories need at least one target.") +;;;###autoload (defclass ede-cpp-root-project (ede-project eieio-instance-tracker) ((tracking-symbol :initform 'ede-cpp-root-project-list) (include-path :initarg :include-path @@ -339,6 +341,15 @@ It should return the fully qualified file name passed in from NAME. If that file does not exist, it should return nil." ) + (compile-command :initarg :compile-command + :initform nil + :type (or null string function) + :documentation + "Compilation command that will be used for this project. +It could be string or function that will accept proj argument and should return string. +The string will be passed to 'compuile' function that will be issued in root +directory of project." + ) ) "EDE cpp-root project class. Each directory needs a project file to control it.") @@ -366,7 +377,7 @@ (when (or (not (file-exists-p f)) (file-directory-p f)) (delete-instance this) - (error ":file for ede-cpp-root must be a file")) + (error ":file for ede-cpp-root-project must be a file")) (oset this :file f) (oset this :directory (file-name-directory f)) (ede-project-directory-remove-hash (file-name-directory f)) @@ -404,7 +415,8 @@ :name (file-name-nondirectory (directory-file-name dir)) :path dir - :source nil)) + :source nil + :project proj)) (object-add-to-list proj :targets ans) ) ans)) @@ -481,15 +493,6 @@ filename)) -(defmethod ede-set-project-variables ((project ede-cpp-root-project) &optional buffer) - "Set variables local to PROJECT in BUFFER. -Also set up the lexical preprocessor map." - (call-next-method) - (when (and (featurep 'semantic/bovine/c) (featurep 'semantic/lex-spp)) - (setq semantic-lex-spp-project-macro-symbol-obarray - (semantic-lex-make-spp-table (oref project spp-table))) - )) - (defmethod ede-system-include-path ((this ede-cpp-root-project)) "Get the system include path used by project THIS." (oref this system-include-path)) @@ -506,11 +509,18 @@ (table (when expfile (semanticdb-file-table-object expfile))) ) - (if (not table) - (message "Cannot find file %s in project." F) + (cond + ((not (file-exists-p expfile)) + (message "Cannot find file %s in project." F)) + ((string= expfile (buffer-file-name)) + ;; Don't include this file in it's own spp table. + ) + ((not table) + (message "No db table available for %s." expfile)) + (t (when (semanticdb-needs-refresh-p table) (semanticdb-refresh-table table)) - (setq spp (append spp (oref table lexical-table)))))) + (setq spp (append spp (oref table lexical-table))))))) (oref this spp-files)) spp)) @@ -522,6 +532,29 @@ "Get the pre-processor map for project THIS." (ede-preprocessor-map (ede-target-parent this))) +(defmethod project-compile-project ((proj ede-cpp-root-project) &optional command) + "Compile the entire current project PROJ. +Argument COMMAND is the command to use when compiling." + ;; we need to be in the proj root dir for this to work + (let* ((cmd (oref proj :compile-command)) + (ov (oref proj :local-variables)) + (lcmd (when ov (cdr (assoc 'compile-command ov)))) + (cmd-str (cond + ((stringp cmd) cmd) + ((functionp cmd) (funcall cmd proj)) + ((stringp lcmd) lcmd) + ((functionp lcmd) (funcall lcmd proj))))) + (when cmd-str + (let ((default-directory (ede-project-root-directory proj))) + (compile cmd-str))))) + +(defmethod project-compile-target ((obj ede-cpp-root-target) &optional command) + "Compile the current target OBJ. +Argument COMMAND is the command to use for compiling the target." + (when (oref obj :project) + (project-compile-project (oref obj :project) command))) + + ;;; Quick Hack (defun ede-create-lots-of-projects-under-dir (dir projfile &rest attributes) "Create a bunch of projects under directory DIR. === modified file 'lisp/cedet/ede/emacs.el' --- lisp/cedet/ede/emacs.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/ede/emacs.el 2013-03-21 22:11:03 +0000 @@ -59,7 +59,7 @@ "Get the root directory for DIR." (when (not dir) (setq dir default-directory)) (let ((case-fold-search t) - (proj (ede-emacs-file-existing dir))) + (proj (ede-files-find-existing dir ede-emacs-project-list))) (if proj (ede-up-directory (file-name-directory (oref proj :file))) @@ -134,7 +134,7 @@ Return nil if there isn't one. Argument DIR is the directory it is created for. ROOTPROJ is nil, since there is only one project." - (or (ede-emacs-file-existing dir) + (or (ede-files-find-existing dir ede-emacs-project-list) ;; Doesn't already exist, so let's make one. (let* ((vertuple (ede-emacs-version dir)) (proj (ede-emacs-project === modified file 'lisp/cedet/ede/files.el' --- lisp/cedet/ede/files.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/ede/files.el 2013-03-21 22:11:03 +0000 @@ -50,12 +50,13 @@ There is no completion at the prompt. FILE is searched for within the current EDE project." (interactive "sFile: ") - (let ((fname (ede-expand-filename (ede-current-project) file)) + (let* ((proj (ede-current-project)) + (fname (ede-expand-filename proj file)) ) (unless fname (error "Could not find %s in %s" file - (ede-project-root-directory (ede-current-project)))) + (ede-project-root-directory proj))) (find-file fname))) (defun ede-flush-project-hash () @@ -508,6 +509,26 @@ nil fnd))) +(defun ede-find-project-root (prj-file-name &optional dir) + "Tries to find directory with given project file" + (let ((prj-dir (locate-dominating-file (or dir default-directory) + prj-file-name))) + (when prj-dir + (expand-file-name prj-dir)))) + +(defun ede-files-find-existing (dir prj-list) + "Find a project in the list of projects stored in given variable. +DIR is the directory to search from." + (let ((projs prj-list) + (ans nil)) + (while (and projs (not ans)) + (let ((root (ede-project-root-directory (car projs)))) + (when (string-match (concat "^" (regexp-quote root)) dir) + (setq ans (car projs)))) + (setq projs (cdr projs))) + ans)) + + (provide 'ede/files) ;; Local variables: === modified file 'lisp/cedet/ede/locate.el' --- lisp/cedet/ede/locate.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/ede/locate.el 2013-03-21 22:11:03 +0000 @@ -163,7 +163,7 @@ "Create or update the database for the current project. You cannot create projects for the baseclass." (error "Cannot create/update a database of type %S" - (object-name loc))) + (eieio-object-name loc))) ;;; LOCATE ;; === modified file 'lisp/cedet/ede/pconf.el' --- lisp/cedet/ede/pconf.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/ede/pconf.el 2013-03-21 22:11:03 +0000 @@ -152,7 +152,7 @@ (defmethod ede-proj-configure-recreate ((this ede-proj-project)) "Delete project THIS's configure script and start over." (if (not (ede-proj-configure-file this)) - (error "Could not determine configure.ac for %S" (object-name this))) + (error "Could not determine configure.ac for %S" (eieio-object-name this))) (let ((b (get-file-buffer (ede-proj-configure-file this)))) ;; Destroy all evidence of the old configure.ac (delete-file (ede-proj-configure-file this)) === modified file 'lisp/cedet/ede/proj-elisp.el' --- lisp/cedet/ede/proj-elisp.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/ede/proj-elisp.el 2013-03-21 22:11:03 +0000 @@ -170,7 +170,7 @@ (setq utd (1+ utd))))))) (oref obj source)) - (message "All Emacs Lisp sources are up to date in %s" (object-name obj)) + (message "All Emacs Lisp sources are up to date in %s" (eieio-object-name obj)) (cons comp utd))) (defmethod ede-update-version-in-source ((this ede-proj-target-elisp) version) @@ -194,7 +194,8 @@ (goto-char (match-beginning 1)) (insert version))))) (setq vs (cdr vs))) - (if (not match) (call-next-method))))) + ;; The next method will include comments such as "Version:" + (call-next-method)))) ;;; Makefile generation functions === modified file 'lisp/cedet/ede/proj.el' --- lisp/cedet/ede/proj.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/ede/proj.el 2013-03-21 22:11:03 +0000 @@ -512,11 +512,11 @@ (defmethod project-debug-target ((obj ede-proj-target)) "Run the current project target OBJ in a debugger." - (error "Debug-target not supported by %s" (object-name obj))) + (error "Debug-target not supported by %s" (eieio-object-name obj))) (defmethod project-run-target ((obj ede-proj-target)) "Run the current project target OBJ." - (error "Run-target not supported by %s" (object-name obj))) + (error "Run-target not supported by %s" (eieio-object-name obj))) (defmethod ede-proj-makefile-target-name ((this ede-proj-target)) "Return the name of the main target for THIS target." === modified file 'lisp/cedet/ede/util.el' --- lisp/cedet/ede/util.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/ede/util.el 2013-03-21 22:11:03 +0000 @@ -49,7 +49,7 @@ (defmethod project-update-version ((ot ede-project)) "The :version of the project OT has been updated. Handle saving, or other detail." - (error "project-update-version not supported by %s" (object-name ot))) + (error "project-update-version not supported by %s" (eieio-object-name ot))) (defmethod ede-update-version-in-source ((this ede-project) version) "Change occurrences of a version string in sources. === modified file 'lisp/cedet/semantic.el' --- lisp/cedet/semantic.el 2013-01-31 19:58:56 +0000 +++ lisp/cedet/semantic.el 2013-03-21 22:11:03 +0000 @@ -466,11 +466,10 @@ (widen) (when (or (< end start) (> end (point-max))) (error "Invalid parse region bounds %S, %S" start end)) - (nreverse - (semantic-repeat-parse-whole-stream + (semantic-repeat-parse-whole-stream (or (cdr (assq start semantic-lex-block-streams)) (semantic-lex start end depth)) - nonterminal returnonerror)))) + nonterminal returnonerror))) ;;; Parsing functions ;; @@ -756,7 +755,7 @@ tag 'reparse-symbol nonterm)) tag) (semantic--tag-expand tag)) - result (append tag result)) + result (append result tag)) ;; No error in this case, a purposeful nil means don't ;; store anything. ) @@ -934,7 +933,8 @@ '("--")) (define-key edit-menu [senator-yank-tag] '(menu-item "Yank Tag" senator-yank-tag - :enable (not (ring-empty-p senator-tag-ring)) + :enable (and (boundp 'senator-tag-ring) + (not (ring-empty-p senator-tag-ring))) :help "Yank the head of the tag ring into the buffer")) (define-key edit-menu [senator-copy-tag-to-register] '(menu-item "Copy Tag To Register" senator-copy-tag-to-register === modified file 'lisp/cedet/semantic/analyze.el' --- lisp/cedet/semantic/analyze.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/semantic/analyze.el 2013-03-21 22:11:03 +0000 @@ -800,7 +800,7 @@ (semantic-analyze-pulse context) (with-output-to-temp-buffer "*Semantic Context Analysis*" (princ "Context Type: ") - (princ (object-name context)) + (princ (eieio-object-name context)) (princ "\n") (princ "Bounds: ") (princ (oref context bounds)) === modified file 'lisp/cedet/semantic/analyze/fcn.el' --- lisp/cedet/semantic/analyze/fcn.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/semantic/analyze/fcn.el 2013-03-21 22:11:03 +0000 @@ -255,7 +255,7 @@ (nexttype (semantic-analyze-dereference-metatype type scope type-declaration)) (idx 0)) (catch 'metatype-recursion - (while (and nexttype (not (eq (car nexttype) lasttype))) + (while (and nexttype (not (semantic-tag-similar-p (car nexttype) lasttype))) (setq lasttype (car nexttype) lasttypedeclaration (cadr nexttype)) (setq nexttype (semantic-analyze-dereference-metatype lasttype scope lasttypedeclaration)) === modified file 'lisp/cedet/semantic/bovine/c.el' --- lisp/cedet/semantic/bovine/c.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/semantic/bovine/c.el 2013-03-21 22:11:03 +0000 @@ -155,15 +155,16 @@ ;; not be in a buffer. (semanticdb-refresh-table table t) (error (message "Error updating tables for %S" - (object-name table))))) + (eieio-object-name table))))) (setq filemap (append filemap (oref table lexical-table))) - ;; Update symbol obarray - (setq-mode-local c-mode - semantic-lex-spp-macro-symbol-obarray - (semantic-lex-make-spp-table - (append semantic-lex-c-preprocessor-symbol-map-builtin - semantic-lex-c-preprocessor-symbol-map - filemap))))))))))) + ))))) + ;; Update symbol obarray + (setq-mode-local c-mode + semantic-lex-spp-macro-symbol-obarray + (semantic-lex-make-spp-table + (append semantic-lex-c-preprocessor-symbol-map-builtin + semantic-lex-c-preprocessor-symbol-map + filemap)))))) ;; Make sure the preprocessor symbols are set up when mode-local kicks ;; in. @@ -1946,15 +1947,17 @@ "Do what `semantic-get-local-variables' does, plus add `this' if needed." (let* ((origvar (semantic-get-local-variables-default)) (ct (semantic-current-tag)) - (p (semantic-tag-function-parent ct))) + (p (when (semantic-tag-of-class-p ct 'function) + (or (semantic-tag-function-parent ct) + (car-safe (semantic-find-tags-by-type + "class" (semantic-find-tag-by-overlay))))))) ;; If we have a function parent, then that implies we can - (if (and p (semantic-tag-of-class-p ct 'function)) - ;; Append a new tag THIS into our space. - (cons (semantic-tag-new-variable "this" p nil) + (if p + ;; Append a new tag THIS into our space. + (cons (semantic-tag-new-variable "this" p nil :pointer 1) origvar) ;; No parent, just return the usual - origvar) - )) + origvar))) (define-mode-local-override semantic-idle-summary-current-symbol-info c-mode () @@ -2151,14 +2154,18 @@ (princ "\n"))) (princ "\n\nMacro Summary:\n") + (when semantic-lex-c-preprocessor-symbol-file - (princ "\n Your CPP table is primed from these files:\n") + (princ "\n Your CPP table is primed from these system files:\n") (dolist (file semantic-lex-c-preprocessor-symbol-file) (princ " ") (princ file) (princ "\n") (princ " in table: ") - (princ (object-print (semanticdb-file-table-object file))) + (let ((fto (semanticdb-file-table-object file))) + (if fto + (princ (object-print fto)) + (princ "No Table"))) (princ "\n") )) @@ -2173,7 +2180,7 @@ )) (when semantic-lex-c-preprocessor-symbol-map - (princ "\n User symbol map:\n") + (princ "\n User symbol map (primed from system files):\n") (dolist (S semantic-lex-c-preprocessor-symbol-map) (princ " ") (princ (car S)) @@ -2183,25 +2190,27 @@ )) (when (and (boundp 'ede-object) - ede-object - (arrayp semantic-lex-spp-project-macro-symbol-obarray)) + ede-object) (princ "\n Project symbol map:\n") (when (and (boundp 'ede-object) ede-object) - (princ " Your project symbol map is derived from the EDE object:\n ") + (princ " Your project symbol map is also derived from the EDE object:\n ") (princ (object-print ede-object))) (princ "\n\n") - (let ((macros nil)) - (mapatoms - #'(lambda (symbol) - (setq macros (cons symbol macros))) - semantic-lex-spp-project-macro-symbol-obarray) - (dolist (S macros) - (princ " ") - (princ (symbol-name S)) - (princ " = ") - (princ (symbol-value S)) - (princ "\n") - ))) + (if (arrayp semantic-lex-spp-project-macro-symbol-obarray) + (let ((macros nil)) + (mapatoms + #'(lambda (symbol) + (setq macros (cons symbol macros))) + semantic-lex-spp-project-macro-symbol-obarray) + (dolist (S macros) + (princ " ") + (princ (symbol-name S)) + (princ " = ") + (princ (symbol-value S)) + (princ "\n") + )) + ;; Else, not map + (princ " No Symbols.\n"))) (princ "\n\n Use: M-x semantic-lex-spp-describe RET\n") (princ "\n to see the complete macro table.\n") === modified file 'lisp/cedet/semantic/bovine/gcc.el' --- lisp/cedet/semantic/bovine/gcc.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/semantic/bovine/gcc.el 2013-03-21 22:11:03 +0000 @@ -157,7 +157,11 @@ ;; `cpp' command in `semantic-gcc-setup' doesn't work on ;; Mac, try `gcc'. (apply 'semantic-gcc-query "gcc" cpp-options)))) - (defines (semantic-cpp-defs query)) + (defines (if (stringp query) + (semantic-cpp-defs query) + (message (concat "Could not query gcc for defines. " + "Maybe g++ is not installed.")) + nil)) (ver (cdr (assoc 'version fields))) (host (or (cdr (assoc 'target fields)) (cdr (assoc '--target fields)) === modified file 'lisp/cedet/semantic/complete.el' --- lisp/cedet/semantic/complete.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/semantic/complete.el 2013-03-21 22:11:03 +0000 @@ -678,7 +678,8 @@ ;;(message "Inline Hook installed, but overlay deleted.") (semantic-complete-inline-exit)) ;; Exit if commands caused us to exit the area of interest - (let ((s (semantic-overlay-start semantic-complete-inline-overlay)) + (let ((os (semantic-overlay-get semantic-complete-inline-overlay 'semantic-original-start)) + (s (semantic-overlay-start semantic-complete-inline-overlay)) (e (semantic-overlay-end semantic-complete-inline-overlay)) (b (semantic-overlay-buffer semantic-complete-inline-overlay)) (txt nil) @@ -686,8 +687,10 @@ (cond ;; EXIT when we are no longer in a good place. ((or (not (eq b (current-buffer))) - (<= (point) s) - (> (point) e)) + (< (point) s) + (< (point) os) + (> (point) e) + ) ;;(message "Exit: %S %S %S" s e (point)) (semantic-complete-inline-exit) ) @@ -710,7 +713,6 @@ (t ;; Else, show completions now (semantic-complete-inline-force-display) - )))) ;; If something goes terribly wrong, clean up after ourselves. (error (semantic-complete-inline-exit)))) @@ -761,6 +763,10 @@ (semantic-overlay-put semantic-complete-inline-overlay 'window-config-start (current-window-configuration)) + ;; Save the original start. We need to exit completion if START + ;; moves. + (semantic-overlay-put semantic-complete-inline-overlay + 'semantic-original-start start) ;; Install our command hooks (add-hook 'pre-command-hook 'semantic-complete-pre-command-hook) (add-hook 'post-command-hook 'semantic-complete-post-command-hook) @@ -1171,7 +1177,7 @@ (let ((old nil) (bl semantic-collector-per-buffer-list)) (while (and bl (null old)) - (if (eq (object-class (car bl)) this) + (if (eq (eieio-object-class (car bl)) this) (setq old (car bl)))) (unless old (let ((new (call-next-method))) @@ -1510,7 +1516,7 @@ (insert (semantic-format-tag-summarize tag nil t) "\n\n") (when table (insert "From table: \n") - (insert (object-name table) "\n\n")) + (insert (eieio-object-name table) "\n\n")) (when buf (insert "In buffer: \n\n") (insert (format "%S" buf))) === modified file 'lisp/cedet/semantic/db-el.el' --- lisp/cedet/semantic/db-el.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/semantic/db-el.el 2013-03-21 22:11:03 +0000 @@ -216,9 +216,8 @@ (symbol-name sym) "class" (semantic-elisp-desymbolify - (aref (class-v semanticdb-project-database) - class-public-a)) ;; slots - (semantic-elisp-desymbolify (class-parents sym)) ;; parents + (eieio--class-public-a (class-v semanticdb-project-database))) ;; slots + (semantic-elisp-desymbolify (eieio-class-parents sym)) ;; parents )) ((not toktype) ;; Figure it out on our own. === modified file 'lisp/cedet/semantic/db-file.el' --- lisp/cedet/semantic/db-file.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/semantic/db-file.el 2013-03-21 22:11:03 +0000 @@ -44,6 +44,8 @@ (defcustom semanticdb-default-save-directory (locate-user-emacs-file "semanticdb" ".semanticdb") "Directory name where semantic cache files are stored. +By default, it is either ~/.emacs.d/semanticdb, or ~/.semanticdb depending +on which exists. If this value is nil, files are saved in the current directory. If the value is a valid directory, then it overrides `semanticdb-default-file-name' and stores caches in a coded file name in this directory." @@ -316,7 +318,7 @@ (data-debug-new-buffer (concat "*SEMANTICDB ERROR*")) (data-debug-insert-thing obj "*" "") (setq semanticdb-data-debug-on-write-error nil)) - (message "Error Writing Table: %s" (object-name obj)) + (message "Error Writing Table: %s" (eieio-object-name obj)) (error "%S" (car (cdr tableerror))))) ;; Clear the dirty bit. === modified file 'lisp/cedet/semantic/db-find.el' --- lisp/cedet/semantic/db-find.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/semantic/db-find.el 2013-03-21 22:11:03 +0000 @@ -244,7 +244,7 @@ (let ((tab-idx (semanticdb-get-table-index tab))) ;; Not a full reset? (when (oref tab-idx type-cache) - (require 'db-typecache) + (require 'semantic/db-typecache) (semanticdb-typecache-notify-reset (oref tab-idx type-cache))) ))) @@ -919,7 +919,7 @@ (if (< (length result) 2) (concat "#)")) result " ") @@ -1285,7 +1285,7 @@ (semanticdb-find-tags-collector (lambda (table tags) (semanticdb-find-tags-external-children-of-type-method table type tags)) - path find-file-match)) + path find-file-match t)) (defun semanticdb-find-tags-subclasses-of-type (type &optional path find-file-match) === modified file 'lisp/cedet/semantic/db.el' --- lisp/cedet/semantic/db.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/semantic/db.el 2013-03-21 22:11:03 +0000 @@ -190,7 +190,7 @@ (oref obj index) (let ((idx nil)) (setq idx (funcall semanticdb-default-find-index-class - (concat (object-name obj) " index") + (concat (eieio-object-name obj) " index") ;; Fill in the defaults :table obj )) @@ -469,7 +469,7 @@ (let ((cache (oref table cache)) (obj nil)) (while (and (not obj) cache) - (if (eq (object-class-fast (car cache)) desired-class) + (if (eq (eieio--object-class (car cache)) desired-class) (setq obj (car cache))) (setq cache (cdr cache))) (if obj @@ -520,7 +520,7 @@ (let ((cache (oref db cache)) (obj nil)) (while (and (not obj) cache) - (if (eq (object-class-fast (car cache)) desired-class) + (if (eq (eieio--object-class (car cache)) desired-class) (setq obj (car cache))) (setq cache (cdr cache))) (if obj === modified file 'lisp/cedet/semantic/decorate/include.el' --- lisp/cedet/semantic/decorate/include.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/semantic/decorate/include.el 2013-03-21 22:11:03 +0000 @@ -797,7 +797,7 @@ (dolist (p path) (if (slot-boundp p 'tags) (princ (format "\n %s :\t%d tags, %d are includes. %s" - (object-name-string p) + (eieio-object-name-string p) (length (oref p tags)) (length (semantic-find-tags-by-class 'include p)) @@ -810,7 +810,7 @@ " Needs to be parsed.") (t "")))) (princ (format "\n %s :\tUnparsed" - (object-name-string p)))) + (eieio-object-name-string p)))) ))) ))) === modified file 'lisp/cedet/semantic/ede-grammar.el' --- lisp/cedet/semantic/ede-grammar.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/semantic/ede-grammar.el 2013-03-21 22:11:03 +0000 @@ -162,7 +162,7 @@ (setq comp (1+ comp)) (setq utd (1+ utd)))))))) (oref obj source)) - (message "All Semantic Grammar sources are up to date in %s" (object-name obj)) + (message "All Semantic Grammar sources are up to date in %s" (eieio-object-name obj)) (cons comp utd))) ;;; Makefile generation functions === modified file 'lisp/cedet/semantic/find.el' --- lisp/cedet/semantic/find.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/semantic/find.el 2013-03-21 22:11:03 +0000 @@ -313,6 +313,15 @@ (eq ,class (semantic-tag-class (car tags))) ,table)) +(defmacro semantic-filter-tags-by-class (class &optional table) + "Find all tags of class not in the list CLASS in TABLE. +CLASS is a list of symbols representing the class of the token, +such as 'variable, of 'function.. +TABLE is a tag table. See `semantic-something-to-tag-table'." + `(semantic--find-tags-by-macro + (not (memq (semantic-tag-class (car tags)) ,class)) + ,table)) + (defmacro semantic-find-tags-by-type (type &optional table) "Find all tags of with a type TYPE in TABLE. TYPE is a string or tag representing a data type as defined in the === modified file 'lisp/cedet/semantic/grammar.el' --- lisp/cedet/semantic/grammar.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/semantic/grammar.el 2013-03-21 22:11:03 +0000 @@ -51,6 +51,9 @@ (declare-function semantic-grammar-wy--install-parser "semantic/gram-wy-fallback") +(declare-function semantic-grammar-wy--install-parser + "semantic/gram-wy-fallback") + ;;;; ;;;; Set up lexer === modified file 'lisp/cedet/semantic/sb.el' --- lisp/cedet/semantic/sb.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/semantic/sb.el 2013-03-21 22:11:03 +0000 @@ -43,6 +43,11 @@ :group 'speedbar :type 'integer) +(defvar semantic-sb-filter-tags-of-class '(code) + "Tags classes to not display in speedbar. +Make this buffer local for modes that have different types of tags +that should be ignored.") + (defcustom semantic-sb-button-format-tag-function 'semantic-format-tag-abbreviate "*Function called to create the text for a but from a token." :group 'speedbar @@ -405,7 +410,12 @@ (setq out (semantic-adopt-external-members out)) ;; Dump all the tokens into buckets. (semantic-sb-with-tag-buffer (car out) - (semantic-bucketize out))) + (semantic-bucketize out nil + (lambda (tagsin) + ;; Remove all boring tags. + (semantic-filter-tags-by-class + semantic-sb-filter-tags-of-class + tagsin))))) (error t)) t))) === modified file 'lisp/cedet/semantic/sort.el' --- lisp/cedet/semantic/sort.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/semantic/sort.el 2013-03-21 22:11:03 +0000 @@ -522,7 +522,7 @@ (semanticdb-minor-mode-p) (require 'semantic/db-find)) (let ((m (semanticdb-find-tags-external-children-of-type - (semantic-tag-name tag)))) + (semantic-tag-name tag) tag))) (if m (apply #'append (mapcar #'cdr m)))) (semantic--find-tags-by-function `(lambda (tok) === modified file 'lisp/cedet/semantic/tag-ls.el' --- lisp/cedet/semantic/tag-ls.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/semantic/tag-ls.el 2013-03-21 22:11:03 +0000 @@ -146,36 +146,42 @@ IGNORABLE-ATTRIBUTES are tag attributes that can be ignored. See `semantic-tag-similar-p' for details." - (let* ((ignore (append ignorable-attributes semantic-tag-similar-ignorable-attributes)) - (A1 (and (semantic--tag-similar-names-p tag1 tag2 (memq :name ignore)) - (semantic--tag-similar-types-p tag1 tag2) - (semantic-tag-of-class-p tag1 (semantic-tag-class tag2)))) - (attr1 (semantic-tag-attributes tag1)) - (attr2 (semantic-tag-attributes tag2)) - (A2 t) - (A3 t) - ) - ;; Test if there are non-ignorable attributes in A2 which are not present in A1 - (while (and A2 attr2) - (let ((a (car attr2))) - (unless (or (eq a :type) (memq a ignore)) - (setq A2 (semantic-tag-get-attribute tag1 a))) - (setq attr2 (cdr (cdr attr2))))) - (while (and A2 attr1 A3) - (let ((a (car attr1))) - - (cond ((or (eq a :type) ;; already tested above. - (memq a ignore)) ;; Ignore them... - nil) - - (t - (setq A3 - (semantic--tag-attribute-similar-p - a (car (cdr attr1)) (semantic-tag-get-attribute tag2 a) - ignorable-attributes))) - )) - (setq attr1 (cdr (cdr attr1)))) - (and A1 A2 A3))) + (or + ;; Tags are similar if they have the exact same lisp object + ;; Added for performance when testing a relatively common case in some uses + ;; of this code. + (eq tag1 tag2) + ;; More complex similarness test. + (let* ((ignore (append ignorable-attributes semantic-tag-similar-ignorable-attributes)) + (A1 (and (semantic--tag-similar-names-p tag1 tag2 (memq :name ignore)) + (semantic--tag-similar-types-p tag1 tag2) + (semantic-tag-of-class-p tag1 (semantic-tag-class tag2)))) + (attr1 (semantic-tag-attributes tag1)) + (attr2 (semantic-tag-attributes tag2)) + (A2 t) + (A3 t) + ) + ;; Test if there are non-ignorable attributes in A2 which are not present in A1 + (while (and A2 attr2) + (let ((a (car attr2))) + (unless (or (eq a :type) (memq a ignore)) + (setq A2 (semantic-tag-get-attribute tag1 a))) + (setq attr2 (cdr (cdr attr2))))) + (while (and A2 attr1 A3) + (let ((a (car attr1))) + + (cond ((or (eq a :type) ;; already tested above. + (memq a ignore)) ;; Ignore them... + nil) + + (t + (setq A3 + (semantic--tag-attribute-similar-p + a (car (cdr attr1)) (semantic-tag-get-attribute tag2 a) + ignorable-attributes))) + )) + (setq attr1 (cdr (cdr attr1)))) + (and A1 A2 A3)))) ;;; FULL NAMES ;; === modified file 'lisp/cedet/srecode/args.el' --- lisp/cedet/srecode/args.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/srecode/args.el 2013-03-21 22:11:03 +0000 @@ -157,6 +157,30 @@ (srecode-dictionary-show-section dict "RCS") ))) +;;; :project ARGUMENT HANDLING +;; +;; When the :project argument is required, fill the dictionary with +;; information that the current project (from EDE) might know +(defun srecode-semantic-handle-:project (dict) + "Add macros into the dictionary DICT based on the current ede project." + (let* ((bfn (buffer-file-name)) + (dir (file-name-directory bfn))) + (if (ede-toplevel) + (let* ((projecttop (ede-toplevel-project default-directory)) + (relfname (file-relative-name bfn projecttop)) + (reldir (file-relative-name dir projecttop)) + ) + (srecode-dictionary-set-value dict "PROJECT_FILENAME" relfname) + (srecode-dictionary-set-value dict "PROJECT_DIRECTORY" reldir) + (srecode-dictionary-set-value dict "PROJECT_NAME" (ede-name (ede-toplevel))) + (srecode-dictionary-set-value dict "PROJECT_VERSION" (oref (ede-toplevel) :version)) + ) + ;; If there is no EDE project, then put in some base values. + (srecode-dictionary-set-value dict "PROJECT_FILENAME" bfn) + (srecode-dictionary-set-value dict "PROJECT_DIRECTORY" dir) + (srecode-dictionary-set-value dict "PROJECT_NAME" "N/A") + (srecode-dictionary-set-value dict "PROJECT_VERSION" "1.0")))) + ;;; :system ARGUMENT HANDLING ;; ;; When a :system argument is required, fill the dictionary with === modified file 'lisp/cedet/srecode/compile.el' --- lisp/cedet/srecode/compile.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/srecode/compile.el 2013-03-21 22:11:03 +0000 @@ -510,12 +510,12 @@ ;;(message "Compile: %s %S" name props) (if (not key) (apply 'srecode-template-inserter-variable name props) - (let ((classes (class-children srecode-template-inserter)) + (let ((classes (eieio-class-children srecode-template-inserter)) (new nil)) ;; Loop over the various subclasses and ;; create the correct inserter. (while (and (not new) classes) - (setq classes (append classes (class-children (car classes)))) + (setq classes (append classes (eieio-class-children (car classes)))) ;; Do we have a match? (when (and (not (class-abstract-p (car classes))) (equal (oref (car classes) key) key)) @@ -594,7 +594,7 @@ (defmethod srecode-dump ((tmp srecode-template)) "Dump the contents of the SRecode template tmp." (princ "== Template \"") - (princ (object-name-string tmp)) + (princ (eieio-object-name-string tmp)) (princ "\" in context ") (princ (oref tmp context)) (princ "\n") @@ -640,12 +640,12 @@ (defmethod srecode-dump ((ins srecode-template-inserter) indent) "Dump the state of the SRecode template inserter INS." (princ "INS: \"") - (princ (object-name-string ins)) + (princ (eieio-object-name-string ins)) (when (oref ins :secondname) (princ "\" : \"") (princ (oref ins :secondname))) (princ "\" type \"") - (let* ((oc (symbol-name (object-class ins))) + (let* ((oc (symbol-name (eieio-object-class ins))) (junk (string-match "srecode-template-inserter-" oc)) (on (if junk (substring oc (match-end 0)) === modified file 'lisp/cedet/srecode/cpp.el' --- lisp/cedet/srecode/cpp.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/srecode/cpp.el 2013-03-21 22:11:03 +0000 @@ -70,8 +70,7 @@ (srecode-dictionary-show-section dict "NOTHEADER")) ;; Strip out bad characters - (while (string-match "\\.\\| " fsym) - (setq fsym (replace-match "_" t t fsym))) + (setq fsym (replace-regexp-in-string "[^a-zA-Z0-9_]" "_" fsym)) (srecode-dictionary-set-value dict "FILENAME_SYMBOL" fsym) ) ) === modified file 'lisp/cedet/srecode/dictionary.el' --- lisp/cedet/srecode/dictionary.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/srecode/dictionary.el 2013-03-21 22:11:03 +0000 @@ -175,7 +175,7 @@ ((srecode-dictionary-child-p buffer-or-parent) (setq parent buffer-or-parent buffer (oref buffer-or-parent buffer) - origin (concat (object-name buffer-or-parent) " in " + origin (concat (eieio-object-name buffer-or-parent) " in " (if buffer (buffer-name buffer) "no buffer"))) (when buffer @@ -454,12 +454,12 @@ method could return nil, but if it does that, it must insert the value itself using `princ', or by detecting if the current standard out is a buffer, and using `insert'." - (object-name cp)) + (eieio-object-name cp)) (defmethod srecode-dump ((cp srecode-dictionary-compound-value) &optional indent) "Display information about this compound value." - (princ (object-name cp)) + (princ (eieio-object-name cp)) ) (defmethod srecode-compound-toString ((cp srecode-dictionary-compound-variable) @@ -654,7 +654,7 @@ 4))) (while entry (princ " --> SUBDICTIONARY ") - (princ (object-name dict)) + (princ (eieio-object-name dict)) (princ "\n") (srecode-dump (car entry) newindent) (setq entry (cdr entry)) === modified file 'lisp/cedet/srecode/insert.el' --- lisp/cedet/srecode/insert.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/srecode/insert.el 2013-03-21 22:11:03 +0000 @@ -809,7 +809,7 @@ (srecode-insert-report-error dict "Only section dictionaries allowed for `%s'" - (object-name-string sti))) + (eieio-object-name-string sti))) ;; Output the code from the sub-template. (srecode-insert-method (slot-value sti slot) dict)) @@ -866,7 +866,7 @@ (let* ((out (srecode-compile-split-code tag input STATE (oref ins :object-name)))) (oset ins template (srecode-template - (object-name-string ins) + (eieio-object-name-string ins) :context nil :args nil :code (cdr out))) === modified file 'lisp/cedet/srecode/java.el' --- lisp/cedet/srecode/java.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/srecode/java.el 2013-03-21 22:11:03 +0000 @@ -42,9 +42,24 @@ ) (while (string-match "\\.\\| " fpak) (setq fpak (replace-match "_" t t fpak))) - (if (string-match "src/" dir) - (setq dir (substring dir (match-end 0))) - (setq dir (file-name-nondirectory (directory-file-name dir)))) + ;; We can extract package from: + ;; 1) a java EDE project source paths, + (cond ((ede-current-project) + (let* ((proj (ede-current-project)) + (pths (ede-source-paths proj 'java-mode)) + (pth) + (res)) + (while (and (not res) + (setq pth (expand-file-name (car pths)))) + (when (string-match pth dir) + (setq res (substring dir (match-end 0)))) + (setq pths (cdr pths))) + (setq dir res))) + ;; 2) a simple heuristic + ((string-match "src/" dir) + (setq dir (substring dir (match-end 0)))) + ;; 3) outer directory as a fallback + (t (setq dir (file-name-nondirectory (directory-file-name dir))))) (setq dir (directory-file-name dir)) (while (string-match "/" dir) (setq dir (replace-match "." t t dir))) === modified file 'lisp/cedet/srecode/map.el' --- lisp/cedet/srecode/map.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/srecode/map.el 2013-03-21 22:11:03 +0000 @@ -363,6 +363,9 @@ (let ((semantic-init-hook nil)) (semantic-new-buffer-fcn)) ) + ;; Force semantic to be enabled in this buffer. + (unless (semantic-active-p) + (semantic-new-buffer-fcn)) (semantic-fetch-tags) (let* ((mode-tag === modified file 'lisp/cedet/srecode/mode.el' --- lisp/cedet/srecode/mode.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/srecode/mode.el 2013-03-21 22:11:03 +0000 @@ -225,7 +225,7 @@ (ctxtcons (assoc ctxt alltabs)) (bind (if (slot-boundp temp 'binding) (oref temp binding))) - (name (object-name-string temp))) + (name (eieio-object-name-string temp))) (when (not ctxtcons) (if (string= context ctxt) === modified file 'lisp/cedet/srecode/srt-mode.el' --- lisp/cedet/srecode/srt-mode.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/srecode/srt-mode.el 2013-03-21 22:11:03 +0000 @@ -187,7 +187,7 @@ "Keymap used in srecode mode.") ;;;###autoload -(define-derived-mode srecode-template-mode fundamental-mode "SRecorder" +(define-derived-mode srecode-template-mode fundamental-mode "SRecode" "Major-mode for writing SRecode macros." (set (make-local-variable 'comment-start) ";;") (set (make-local-variable 'comment-end) "") @@ -232,7 +232,7 @@ "Provide help for working with macros in a template." (interactive) (let* ((root 'srecode-template-inserter) - (chl (aref (class-v root) class-children)) + (chl (eieio--class-children (class-v root))) (ess (srecode-template-get-escape-start)) (ees (srecode-template-get-escape-end)) ) @@ -248,7 +248,7 @@ (showexample t) ) (setq chl (cdr chl)) - (setq chl (append (aref (class-v C) class-children) chl)) + (setq chl (append (eieio--class-children (class-v C)) chl)) (catch 'skip (when (eq C 'srecode-template-inserter-section-end) === modified file 'lisp/cedet/srecode/srt.el' --- lisp/cedet/srecode/srt.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/srecode/srt.el 2013-03-21 22:11:03 +0000 @@ -69,6 +69,7 @@ nil initial (or hist 'srecode-read-major-mode-history)) ) +;;;###autoload (defun srecode-semantic-handle-:srt (dict) "Add macros into the dictionary DICT based on the current SRT file. Adds the following: @@ -104,4 +105,9 @@ (provide 'srecode/srt) +;; Local variables: +;; generated-autoload-file: "loaddefs.el" +;; generated-autoload-load-name: "srecode/srt" +;; End: + ;;; srecode/srt.el ends here === modified file 'lisp/cedet/srecode/table.el' --- lisp/cedet/srecode/table.el 2013-01-01 09:11:05 +0000 +++ lisp/cedet/srecode/table.el 2013-03-21 22:11:03 +0000 @@ -251,7 +251,7 @@ (defmethod srecode-dump ((tab srecode-template-table)) "Dump the contents of the SRecode template table TAB." (princ "Template Table for ") - (princ (object-name-string tab)) + (princ (eieio-object-name-string tab)) (princ "\nPriority: ") (prin1 (oref tab :priority)) (when (oref tab :application) === modified file 'lisp/emacs-lisp/eieio-datadebug.el' --- lisp/emacs-lisp/eieio-datadebug.el 2013-02-19 02:57:04 +0000 +++ lisp/emacs-lisp/eieio-datadebug.el 2013-03-21 22:11:03 +0000 @@ -80,38 +80,39 @@ ;; Each object should have an opportunity to show stuff about itself. (defmethod data-debug/eieio-insert-slots ((obj eieio-default-superclass) - prefix) + prefix) "Insert the slots of OBJ into the current DDEBUG buffer." - (data-debug-insert-thing (eieio-object-name-string obj) - prefix - "Name: ") - (let* ((cl (eieio-object-class obj)) - (cv (class-v cl))) - (data-debug-insert-thing (class-constructor cl) - prefix - "Class: ") - ;; Loop over all the public slots - (let ((publa (eieio--class-public-a cv)) - ) - (while publa - (if (slot-boundp obj (car publa)) - (let* ((i (class-slot-initarg cl (car publa))) - (v (eieio-oref obj (car publa)))) - (data-debug-insert-thing - v prefix (concat - (if i (symbol-name i) - (symbol-name (car publa))) - " "))) - ;; Unbound case - (let ((i (class-slot-initarg cl (car publa)))) - (data-debug-insert-custom - "#unbound" prefix - (concat (if i (symbol-name i) - (symbol-name (car publa))) - " ") - 'font-lock-keyword-face)) - ) - (setq publa (cdr publa)))))) + (let ((inhibit-read-only t)) + (data-debug-insert-thing (eieio-object-name-string obj) + prefix + "Name: ") + (let* ((cl (eieio-object-class obj)) + (cv (class-v cl))) + (data-debug-insert-thing (class-constructor cl) + prefix + "Class: ") + ;; Loop over all the public slots + (let ((publa (eieio--class-public-a cv)) + ) + (while publa + (if (slot-boundp obj (car publa)) + (let* ((i (class-slot-initarg cl (car publa))) + (v (eieio-oref obj (car publa)))) + (data-debug-insert-thing + v prefix (concat + (if i (symbol-name i) + (symbol-name (car publa))) + " "))) + ;; Unbound case + (let ((i (class-slot-initarg cl (car publa)))) + (data-debug-insert-custom + "#unbound" prefix + (concat (if i (symbol-name i) + (symbol-name (car publa))) + " ") + 'font-lock-keyword-face)) + ) + (setq publa (cdr publa))))))) ;;; Augment the Data debug thing display list. (data-debug-add-specialized-thing (lambda (thing) (object-p thing)) ------------------------------------------------------------ revno: 112109 committer: Ted Zlatanov branch nick: quickfixes timestamp: Fri 2013-03-22 15:06:53 -0400 message: * progmodes/cfengine.el: Use symbol motion commands instead of extending the word syntax. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-03-21 16:11:13 +0000 +++ lisp/ChangeLog 2013-03-22 19:06:53 +0000 @@ -1,3 +1,9 @@ +2013-03-22 Teodor Zlatanov + + * progmodes/cfengine.el: Update docs to mention + `cfengine-auto-mode'. Use \_> and \_< instead of \> and \< for + symbol motion. Remove "_" from the word syntax. + 2013-03-21 Teodor Zlatanov * progmodes/cfengine.el (cfengine-common-syntax): Add "_" to word === modified file 'lisp/progmodes/cfengine.el' --- lisp/progmodes/cfengine.el 2013-03-21 16:11:13 +0000 +++ lisp/progmodes/cfengine.el 2013-03-22 19:06:53 +0000 @@ -30,11 +30,13 @@ ;; The CFEngine 3.x support doesn't have Imenu support but patches are ;; welcome. +;; By default, CFEngine 3.x syntax is used. + ;; You can set it up so either `cfengine2-mode' (2.x and earlier) or ;; `cfengine3-mode' (3.x) will be picked, depending on the buffer ;; contents: -;; (add-to-list 'auto-mode-alist '("\\.cf\\'" . cfengine-mode)) +;; (add-to-list 'auto-mode-alist '("\\.cf\\'" . cfengine-auto-mode)) ;; OR you can choose to always use a specific version, if you prefer ;; it: @@ -181,7 +183,7 @@ ("$(\\([[:alnum:]_]+\\))" 1 font-lock-variable-name-face) ("${\\([[:alnum:]_]+\\)}" 1 font-lock-variable-name-face) ;; Variable definitions. - ("\\<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1 font-lock-variable-name-face) + ("\\_<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1 font-lock-variable-name-face) ;; File, acl &c in group: { token ... } ("{[ \t]*\\([^ \t\n]+\\)" 1 font-lock-constant-face))) @@ -189,9 +191,9 @@ `( ;; Defuns. This happens early so they don't get caught by looser ;; patterns. - (,(concat "\\<" cfengine3-defuns-regex "\\>" - "[ \t]+\\<\\([[:alnum:]_.:]+\\)\\>" - "[ \t]+\\<\\([[:alnum:]_.:]+\\)" + (,(concat "\\_<" cfengine3-defuns-regex "\\_>" + "[ \t]+\\_<\\([[:alnum:]_.:]+\\)\\_>" + "[ \t]+\\_<\\([[:alnum:]_.:]+\\)" ;; Optional parentheses with variable names inside. "\\(?:(\\([^)]*\\))\\)?") (1 font-lock-builtin-face) @@ -212,10 +214,10 @@ ("[@$]{\\([[:alnum:]_.:]+\\)}" 1 font-lock-variable-name-face) ;; Variable definitions. - ("\\<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1 font-lock-variable-name-face) + ("\\_<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1 font-lock-variable-name-face) ;; Variable types. - (,(concat "\\<" (eval-when-compile (regexp-opt cfengine3-vartypes t)) "\\>") + (,(concat "\\_<" (eval-when-compile (regexp-opt cfengine3-vartypes t)) "\\_>") 1 font-lock-type-face))) (defvar cfengine2-imenu-expression @@ -223,9 +225,9 @@ (regexp-opt cfengine2-actions t)) ":[^:]") 1) - ("Variables/classes" "\\<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1) - ("Variables/classes" "\\[ \t]+\\([[:alnum:]_]+\\)" 1)) + ("Variables/classes" "\\_<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1) + ("Variables/classes" "\\_[ \t]+\\([[:alnum:]_]+\\)" 1)) "`imenu-generic-expression' for CFEngine mode.") (defun cfengine2-outline-level () @@ -338,7 +340,7 @@ Treats body/bundle blocks as defuns." (unless (<= (current-column) (current-indentation)) (end-of-line)) - (if (re-search-backward (concat "^[ \t]*" cfengine3-defuns-regex "\\>") nil t) + (if (re-search-backward (concat "^[ \t]*" cfengine3-defuns-regex "\\_>") nil t) (beginning-of-line) (goto-char (point-min))) t) @@ -347,7 +349,7 @@ "`end-of-defun' function for Cfengine 3 mode. Treats body/bundle blocks as defuns." (end-of-line) - (if (re-search-forward (concat "^[ \t]*" cfengine3-defuns-regex "\\>") nil t) + (if (re-search-forward (concat "^[ \t]*" cfengine3-defuns-regex "\\_>") nil t) (beginning-of-line) (goto-char (point-max))) t) @@ -366,7 +368,7 @@ (cond ;; Body/bundle blocks start at 0. - ((looking-at (concat cfengine3-defuns-regex "\\>")) + ((looking-at (concat cfengine3-defuns-regex "\\_>")) (indent-line-to 0)) ;; Categories are indented one step. ((looking-at (concat cfengine3-category-regex "[ \t]*\\(#.*\\)*$")) @@ -516,7 +518,6 @@ (defun cfengine-common-syntax (table) ;; The syntax defaults seem OK to give reasonable word movement. - (modify-syntax-entry ?w "_" table) (modify-syntax-entry ?# "<" table) (modify-syntax-entry ?\n ">#" table) (modify-syntax-entry ?\" "\"" table) ; "string" @@ -584,7 +585,7 @@ (save-restriction (goto-char (point-min)) (while (not (or (eobp) v3)) - (setq v3 (looking-at (concat cfengine3-defuns-regex "\\>"))) + (setq v3 (looking-at (concat cfengine3-defuns-regex "\\_>"))) (forward-line))) (if v3 (cfengine3-mode) (cfengine2-mode)))) ------------------------------------------------------------ revno: 112108 committer: Ken Brown branch nick: trunk timestamp: Fri 2013-03-22 12:52:31 -0400 message: * src/unexcw.c: Update for x86_64-cygwin. Drop unneeded inclusion of w32common.h. (report_sheap_usage): Declare. (read_exe_header): Add magic numbers for x86_64. (fixup_executable): Fix printf format specifier for unsigned long argument. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-03-22 12:41:34 +0000 +++ src/ChangeLog 2013-03-22 16:52:31 +0000 @@ -1,3 +1,11 @@ +2013-03-22 Ken Brown + + * unexcw.c: Drop unneeded inclusion of w32common.h. + (report_sheap_usage): Declare. + (read_exe_header): Add magic numbers for x86_64. + (fixup_executable): Fix printf format specifier for unsigned long + argument. + 2013-03-22 Dmitry Antipov * frame.h (struct frame): Put menu_bar_window under #ifdef === modified file 'src/unexcw.c' --- src/unexcw.c 2013-01-02 16:13:04 +0000 +++ src/unexcw.c 2013-03-22 16:52:31 +0000 @@ -20,7 +20,6 @@ #include #include "unexec.h" -#include "w32common.h" #include #include @@ -31,6 +30,8 @@ #define DOTEXE ".exe" +extern void report_sheap_usage (int); + extern int bss_sbrk_did_unexec; extern int __malloc_initialized; @@ -73,7 +74,11 @@ assert (exe_header_buffer->file_header.e_magic == 0x5a4d); assert (exe_header_buffer->file_header.nt_signature == 0x4550); +#ifdef __x86_64__ + assert (exe_header_buffer->file_header.f_magic == 0x8664); +#else assert (exe_header_buffer->file_header.f_magic == 0x014c); +#endif assert (exe_header_buffer->file_header.f_nscns > 0); assert (exe_header_buffer->file_header.f_nscns <= sizeof (exe_header_buffer->section_header) / @@ -85,7 +90,11 @@ sizeof (exe_header_buffer->file_optional_header)); assert (ret == sizeof (exe_header_buffer->file_optional_header)); +#ifdef __x86_64__ + assert (exe_header_buffer->file_optional_header.magic == 0x020b); +#else assert (exe_header_buffer->file_optional_header.magic == 0x010b); +#endif for (i = 0; i < exe_header_buffer->file_header.f_nscns; ++i) { @@ -132,7 +141,7 @@ exe_header->file_optional_header.ImageBase + exe_header->section_header[i].s_paddr; if (debug_unexcw) - printf ("%8s start 0x%08x end 0x%08x\n", + printf ("%8s start %#lx end %#lx\n", exe_header->section_header[i].s_name, start_address, end_address); if (my_edata >= (char *) start_address @@ -149,7 +158,7 @@ assert (ret == my_edata - (char *) start_address); ++found_data; if (debug_unexcw) - printf (" .data, mem start 0x%08x mem length %d\n", + printf (" .data, mem start %#lx mem length %d\n", start_address, my_edata - (char *) start_address); if (debug_unexcw) printf (" .data, file start %d file length %d\n", @@ -233,7 +242,7 @@ __malloc_initialized = 1; assert (ret == (my_endbss - (char *) start_address)); if (debug_unexcw) - printf (" .bss, mem start 0x%08x mem length %d\n", + printf (" .bss, mem start %#lx mem length %d\n", start_address, my_endbss - (char *) start_address); if (debug_unexcw) printf (" .bss, file start %d file length %d\n", ------------------------------------------------------------ revno: 112107 committer: Dmitry Antipov branch nick: trunk timestamp: Fri 2013-03-22 16:41:34 +0400 message: * frame.h (struct frame): Put menu_bar_window under #ifdef because this member is not needed when X toolkit is in use. (fset_menu_bar_window): * dispnew.c (clear_current_matrices, clear_desired_matrices) (free_glyphs, update_frame): * xdisp.c (expose_frame): Likewise. (display_menu_bar): Likewise. Remove redundant eassert. * window.h (WINDOW_MENU_BAR_P): Always define to 0 if X toolkit is in use. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-03-21 20:56:22 +0000 +++ src/ChangeLog 2013-03-22 12:41:34 +0000 @@ -1,3 +1,15 @@ +2013-03-22 Dmitry Antipov + + * frame.h (struct frame): Put menu_bar_window under #ifdef + because this member is not needed when X toolkit is in use. + (fset_menu_bar_window): + * dispnew.c (clear_current_matrices, clear_desired_matrices) + (free_glyphs, update_frame): + * xdisp.c (expose_frame): Likewise. + (display_menu_bar): Likewise. Remove redundant eassert. + * window.h (WINDOW_MENU_BAR_P): Always define to 0 if X + toolkit is in use. + 2013-03-21 Paul Eggert Use functions and constants to manipulate Lisp_Save_Value objects. === modified file 'src/dispnew.c' --- src/dispnew.c 2013-03-20 11:29:37 +0000 +++ src/dispnew.c 2013-03-22 12:41:34 +0000 @@ -794,11 +794,13 @@ if (f->current_matrix) clear_glyph_matrix (f->current_matrix); +#if defined (HAVE_X_WINDOWS) && ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK) /* Clear the matrix of the menu bar window, if such a window exists. The menu bar window is currently used to display menus on X when no toolkit support is compiled in. */ if (WINDOWP (f->menu_bar_window)) clear_glyph_matrix (XWINDOW (f->menu_bar_window)->current_matrix); +#endif /* Clear the matrix of the tool-bar window, if any. */ if (WINDOWP (f->tool_bar_window)) @@ -818,8 +820,10 @@ if (f->desired_matrix) clear_glyph_matrix (f->desired_matrix); +#if defined (HAVE_X_WINDOWS) && ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK) if (WINDOWP (f->menu_bar_window)) clear_glyph_matrix (XWINDOW (f->menu_bar_window)->desired_matrix); +#endif if (WINDOWP (f->tool_bar_window)) clear_glyph_matrix (XWINDOW (f->tool_bar_window)->desired_matrix); @@ -2184,6 +2188,7 @@ if (!NILP (f->root_window)) free_window_matrices (XWINDOW (f->root_window)); +#if defined (HAVE_X_WINDOWS) && ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK) /* Free the dummy window for menu bars without X toolkit and its glyph matrices. */ if (!NILP (f->menu_bar_window)) @@ -2194,6 +2199,7 @@ w->desired_matrix = w->current_matrix = NULL; fset_menu_bar_window (f, Qnil); } +#endif /* Free the tool bar window and its glyph matrices. */ if (!NILP (f->tool_bar_window)) @@ -3092,10 +3098,12 @@ when pending input is detected. */ update_begin (f); +#if defined (HAVE_X_WINDOWS) && ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK) /* Update the menu bar on X frames that don't have toolkit support. */ if (WINDOWP (f->menu_bar_window)) update_window (XWINDOW (f->menu_bar_window), 1); +#endif /* Update the tool-bar window, if present. */ if (WINDOWP (f->tool_bar_window)) === modified file 'src/frame.h' --- src/frame.h 2013-03-20 09:56:19 +0000 +++ src/frame.h 2013-03-22 12:41:34 +0000 @@ -170,9 +170,11 @@ most recently buried buffer is first. For last-buffer. */ Lisp_Object buried_buffer_list; +#if defined (HAVE_X_WINDOWS) && ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK) /* A dummy window used to display menu bars under X when no X toolkit support is available. */ Lisp_Object menu_bar_window; +#endif /* A window used to display the tool-bar of a frame. */ Lisp_Object tool_bar_window; @@ -515,11 +517,13 @@ { f->menu_bar_vector = val; } +#if defined (HAVE_X_WINDOWS) && ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK) FRAME_INLINE void fset_menu_bar_window (struct frame *f, Lisp_Object val) { f->menu_bar_window = val; } +#endif FRAME_INLINE void fset_name (struct frame *f, Lisp_Object val) { === modified file 'src/window.h' --- src/window.h 2013-03-20 11:29:37 +0000 +++ src/window.h 2013-03-22 12:41:34 +0000 @@ -512,9 +512,14 @@ /* 1 if W is a menu bar window. */ +#if defined (HAVE_X_WINDOWS) && ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK) #define WINDOW_MENU_BAR_P(W) \ (WINDOWP (WINDOW_XFRAME (W)->menu_bar_window) \ && (W) == XWINDOW (WINDOW_XFRAME (W)->menu_bar_window)) +#else +/* No menu bar windows if X toolkit is in use. */ +#define WINDOW_MENU_BAR_P(W) (0) +#endif /* 1 if W is a tool bar window. */ === modified file 'src/xdisp.c' --- src/xdisp.c 2013-03-20 11:29:37 +0000 +++ src/xdisp.c 2013-03-22 12:41:34 +0000 @@ -19988,18 +19988,17 @@ return; #endif /* HAVE_NS */ -#ifdef USE_X_TOOLKIT +#if defined (USE_X_TOOLKIT) || defined (USE_GTK) eassert (!FRAME_WINDOW_P (f)); init_iterator (&it, w, -1, -1, f->desired_matrix->rows, MENU_FACE_ID); it.first_visible_x = 0; it.last_visible_x = FRAME_TOTAL_COLS (f) * FRAME_COLUMN_WIDTH (f); -#else /* not USE_X_TOOLKIT */ +#elif defined (HAVE_X_WINDOWS) /* X without toolkit. */ if (FRAME_WINDOW_P (f)) { /* Menu bar lines are displayed in the desired matrix of the dummy window menu_bar_window. */ struct window *menu_w; - eassert (WINDOWP (f->menu_bar_window)); menu_w = XWINDOW (f->menu_bar_window); init_iterator (&it, menu_w, -1, -1, menu_w->desired_matrix->rows, MENU_FACE_ID); @@ -20007,6 +20006,7 @@ it.last_visible_x = FRAME_TOTAL_COLS (f) * FRAME_COLUMN_WIDTH (f); } else +#endif /* not USE_X_TOOLKIT and not USE_GTK */ { /* This is a TTY frame, i.e. character hpos/vpos are used as pixel x/y. */ @@ -20015,7 +20015,6 @@ it.first_visible_x = 0; it.last_visible_x = FRAME_COLS (f); } -#endif /* not USE_X_TOOLKIT */ /* FIXME: This should be controlled by a user option. See the comments in redisplay_tool_bar and display_mode_line about @@ -28480,11 +28479,11 @@ #ifdef HAVE_X_WINDOWS #ifndef MSDOS -#ifndef USE_X_TOOLKIT +#if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK) if (WINDOWP (f->menu_bar_window)) mouse_face_overwritten_p |= expose_window (XWINDOW (f->menu_bar_window), &r); -#endif /* not USE_X_TOOLKIT */ +#endif /* not USE_X_TOOLKIT and not USE_GTK */ #endif #endif ------------------------------------------------------------ revno: 112106 committer: Paul Eggert branch nick: trunk timestamp: Thu 2013-03-21 13:56:22 -0700 message: Use functions and constants to manipulate Lisp_Save_Value objects. This replaces code that used macros and strings and token-pasting. The change makes the C source a bit easier to follow, and shrinks the Emacs executable a bit. * alloc.c: Verify some properties of Lisp_Save_Value's representation. (make_save_value): Change 1st arg from string to enum. All callers changed. (INTX): Remove. (mark_object): Use if, not #if, for GC_MARK_STACK. * lisp.h (SAVE_VALUEP, XSAVE_VALUE, XSAVE_POINTER, XSAVE_INTEGER) (XSAVE_OBJECT): Now functions, not macros. (STRING_BYTES_BOUND): Now just a macro, not a constant too; the constant was never used. (SAVE_SLOT_BITS, SAVE_VALUE_SLOTS, SAVE_TYPE_BITS, SAVE_TYPE_INT_INT) (SAVE_TYPE_INT_INT_INT, SAVE_TYPE_OBJ_OBJ, SAVE_TYPE_OBJ_OBJ_OBJ) (SAVE_TYPE_OBJ_OBJ_OBJ_OBJ, SAVE_TYPE_PTR_INT, SAVE_TYPE_PTR_OBJ) (SAVE_TYPE_PTR_PTR, SAVE_TYPE_PTR_PTR_OBJ, SAVE_TYPE_MEMORY): New constants. (struct Lisp_Save_Value): Replace members area, type0, type1, type2, type3 with a single member save_type. All uses changed. (save_type, set_save_pointer, set_save_integer): New functions. * print.c (PRINTX): Remove. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-03-21 18:28:50 +0000 +++ src/ChangeLog 2013-03-21 20:56:22 +0000 @@ -1,5 +1,28 @@ 2013-03-21 Paul Eggert + Use functions and constants to manipulate Lisp_Save_Value objects. + This replaces code that used macros and strings and token-pasting. + The change makes the C source a bit easier to follow, + and shrinks the Emacs executable a bit. + * alloc.c: Verify some properties of Lisp_Save_Value's representation. + (make_save_value): Change 1st arg from string to enum. All callers + changed. + (INTX): Remove. + (mark_object): Use if, not #if, for GC_MARK_STACK. + * lisp.h (SAVE_VALUEP, XSAVE_VALUE, XSAVE_POINTER, XSAVE_INTEGER) + (XSAVE_OBJECT): Now functions, not macros. + (STRING_BYTES_BOUND): Now just a macro, not a constant too; + the constant was never used. + (SAVE_SLOT_BITS, SAVE_VALUE_SLOTS, SAVE_TYPE_BITS, SAVE_TYPE_INT_INT) + (SAVE_TYPE_INT_INT_INT, SAVE_TYPE_OBJ_OBJ, SAVE_TYPE_OBJ_OBJ_OBJ) + (SAVE_TYPE_OBJ_OBJ_OBJ_OBJ, SAVE_TYPE_PTR_INT, SAVE_TYPE_PTR_OBJ) + (SAVE_TYPE_PTR_PTR, SAVE_TYPE_PTR_PTR_OBJ, SAVE_TYPE_MEMORY): + New constants. + (struct Lisp_Save_Value): Replace members area, type0, type1, type2, + type3 with a single member save_type. All uses changed. + (save_type, set_save_pointer, set_save_integer): New functions. + * print.c (PRINTX): Remove. + * alloc.c: Remove redundant static declarations. 2013-03-20 Dmitry Antipov === modified file 'src/alloc.c' --- src/alloc.c 2013-03-21 18:28:50 +0000 +++ src/alloc.c 2013-03-21 20:56:22 +0000 @@ -3326,56 +3326,50 @@ total_free_markers++; } +/* Verify properties of Lisp_Save_Value's representation + that are assumed here and elsewhere. */ + +verify (SAVE_UNUSED == 0); +verify ((SAVE_INTEGER | SAVE_POINTER | SAVE_OBJECT) >> SAVE_SLOT_BITS == 0); + /* Return a Lisp_Save_Value object with the data saved according to - FMT. Format specifiers are `i' for an integer, `p' for a pointer - and `o' for Lisp_Object. Up to 4 objects can be specified. */ + DATA_TYPE. DATA_TYPE should be one of SAVE_TYPE_INT_INT, etc. */ Lisp_Object -make_save_value (const char *fmt, ...) +make_save_value (enum Lisp_Save_Type save_type, ...) { va_list ap; - int len = strlen (fmt); + int i; Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); struct Lisp_Save_Value *p = XSAVE_VALUE (val); - eassert (0 < len && len < 5); - va_start (ap, fmt); - -#define INITX(index) \ - do { \ - if (len <= index) \ - p->type ## index = SAVE_UNUSED; \ - else \ - { \ - if (fmt[index] == 'i') \ - { \ - p->type ## index = SAVE_INTEGER; \ - p->data[index].integer = va_arg (ap, ptrdiff_t); \ - } \ - else if (fmt[index] == 'p') \ - { \ - p->type ## index = SAVE_POINTER; \ - p->data[index].pointer = va_arg (ap, void *); \ - } \ - else if (fmt[index] == 'o') \ - { \ - p->type ## index = SAVE_OBJECT; \ - p->data[index].object = va_arg (ap, Lisp_Object); \ - } \ - else \ - emacs_abort (); \ - } \ - } while (0) - - INITX (0); - INITX (1); - INITX (2); - INITX (3); - -#undef INITX + eassert (0 < save_type + && (save_type < 1 << (SAVE_TYPE_BITS - 1) + || save_type == SAVE_TYPE_MEMORY)); + p->save_type = save_type; + va_start (ap, save_type); + save_type &= ~ (1 << (SAVE_TYPE_BITS - 1)); + + for (i = 0; save_type; i++, save_type >>= SAVE_SLOT_BITS) + switch (save_type & ((1 << SAVE_SLOT_BITS) - 1)) + { + case SAVE_POINTER: + p->data[i].pointer = va_arg (ap, void *); + break; + + case SAVE_INTEGER: + p->data[i].integer = va_arg (ap, ptrdiff_t); + break; + + case SAVE_OBJECT: + p->data[i].object = va_arg (ap, Lisp_Object); + break; + + default: + emacs_abort (); + } va_end (ap); - p->area = 0; return val; } @@ -3386,11 +3380,8 @@ { Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); struct Lisp_Save_Value *p = XSAVE_VALUE (val); - - p->area = 0; - p->type0 = SAVE_POINTER; + p->save_type = SAVE_POINTER; p->data[0].pointer = pointer; - p->type1 = p->type2 = p->type3 = SAVE_UNUSED; return val; } @@ -5958,12 +5949,11 @@ case Lisp_Misc_Save_Value: XMISCANY (obj)->gcmarkbit = 1; { - register struct Lisp_Save_Value *ptr = XSAVE_VALUE (obj); - /* If `area' is nonzero, `data[0].pointer' is the address + struct Lisp_Save_Value *ptr = XSAVE_VALUE (obj); + /* If `save_type' is zero, `data[0].pointer' is the address of a memory area containing `data[1].integer' potential Lisp_Objects. */ -#if GC_MARK_STACK - if (ptr->area) + if (GC_MARK_STACK && ptr->save_type == SAVE_TYPE_MEMORY) { Lisp_Object *p = ptr->data[0].pointer; ptrdiff_t nelt; @@ -5971,17 +5961,12 @@ mark_maybe_object (*p); } else -#endif /* GC_MARK_STACK */ { /* Find Lisp_Objects in `data[N]' slots and mark them. */ - if (ptr->type0 == SAVE_OBJECT) - mark_object (ptr->data[0].object); - if (ptr->type1 == SAVE_OBJECT) - mark_object (ptr->data[1].object); - if (ptr->type2 == SAVE_OBJECT) - mark_object (ptr->data[2].object); - if (ptr->type3 == SAVE_OBJECT) - mark_object (ptr->data[3].object); + int i; + for (i = 0; i < SAVE_VALUE_SLOTS; i++) + if (save_type (ptr, i) == SAVE_OBJECT) + mark_object (ptr->data[i].object); } } break; === modified file 'src/editfns.c' --- src/editfns.c 2013-03-08 09:34:35 +0000 +++ src/editfns.c 2013-03-21 20:56:22 +0000 @@ -839,7 +839,7 @@ save_excursion_save (void) { return make_save_value - ("oooo", + (SAVE_TYPE_OBJ_OBJ_OBJ_OBJ, Fpoint_marker (), /* Do not copy the mark if it points to nowhere. */ (XMARKER (BVAR (current_buffer, mark))->buffer @@ -4241,7 +4241,10 @@ memcpy (buf, initial_buffer, used); } else - XSAVE_POINTER (buf_save_value, 0) = buf = xrealloc (buf, bufsize); + { + buf = xrealloc (buf, bufsize); + set_save_pointer (buf_save_value, 0, buf); + } p = buf + used; } === modified file 'src/fileio.c' --- src/fileio.c 2013-03-13 18:42:22 +0000 +++ src/fileio.c 2013-03-21 20:56:22 +0000 @@ -4218,7 +4218,8 @@ to be signaled after decoding the text we read. */ nbytes = internal_condition_case_1 (read_non_regular, - make_save_value ("iii", (ptrdiff_t) fd, inserted, trytry), + make_save_value (SAVE_TYPE_INT_INT_INT, (ptrdiff_t) fd, + inserted, trytry), Qerror, read_non_regular_quit); if (NILP (nbytes)) === modified file 'src/ftfont.c' --- src/ftfont.c 2013-03-04 07:41:01 +0000 +++ src/ftfont.c 2013-03-21 20:56:22 +0000 @@ -393,7 +393,7 @@ cache_data = xmalloc (sizeof *cache_data); cache_data->ft_face = NULL; cache_data->fc_charset = NULL; - val = make_save_value ("pi", cache_data, 0); + val = make_save_value (SAVE_TYPE_PTR_INT, cache_data, 0); cache = Fcons (Qnil, val); Fputhash (key, cache, ft_face_cache); } @@ -1211,7 +1211,7 @@ return Qnil; } } - XSAVE_INTEGER (val, 1)++; + set_save_integer (val, 1, XSAVE_INTEGER (val, 1) + 1); size = XINT (AREF (entity, FONT_SIZE_INDEX)); if (size == 0) size = pixel_size; @@ -1326,7 +1326,7 @@ cache = ftfont_lookup_cache (val, FTFONT_CACHE_FOR_FACE); eassert (CONSP (cache)); val = XCDR (cache); - XSAVE_INTEGER (val, 1)--; + set_save_integer (val, 1, XSAVE_INTEGER (val, 1) - 1); if (XSAVE_INTEGER (val, 1) == 0) { struct ftfont_cache_data *cache_data = XSAVE_POINTER (val, 0); === modified file 'src/keymap.c' --- src/keymap.c 2013-03-13 07:27:34 +0000 +++ src/keymap.c 2013-03-21 20:56:22 +0000 @@ -611,7 +611,8 @@ } else if (CHAR_TABLE_P (binding)) map_char_table (map_keymap_char_table_item, Qnil, binding, - make_save_value ("ppo", fun, data, args)); + make_save_value (SAVE_TYPE_PTR_PTR_OBJ, + fun, data, args)); } UNGCPRO; return tail; === modified file 'src/lisp.h' --- src/lisp.h 2013-03-19 14:09:05 +0000 +++ src/lisp.h 2013-03-21 20:56:22 +0000 @@ -551,6 +551,12 @@ return num < lower ? lower : num <= upper ? num : upper; } + +/* Forward declarations. */ + +LISP_INLINE bool SAVE_VALUEP (Lisp_Object); +LISP_INLINE struct Lisp_Save_Value *XSAVE_VALUE (Lisp_Object); + /* Extract a value or address from a Lisp_Object. */ #define XCONS(a) (eassert (CONSP (a)), \ @@ -571,7 +577,6 @@ #define XMISCTYPE(a) (XMISCANY (a)->type) #define XMARKER(a) (eassert (MARKERP (a)), &(XMISC (a)->u_marker)) #define XOVERLAY(a) (eassert (OVERLAYP (a)), &(XMISC (a)->u_overlay)) -#define XSAVE_VALUE(a) (eassert (SAVE_VALUEP (a)), &(XMISC (a)->u_save_value)) /* Forwarding object types. */ @@ -781,13 +786,10 @@ would expose alloc.c internal details that we'd rather keep private. - This is a macro for use in static initializers, and a constant for - visibility to GDB. The cast to ptrdiff_t ensures that - the macro is signed. */ -static ptrdiff_t const STRING_BYTES_BOUND = + This is a macro for use in static initializers. The cast to + ptrdiff_t ensures that the macro is signed. */ #define STRING_BYTES_BOUND \ ((ptrdiff_t) min (MOST_POSITIVE_FIXNUM, min (SIZE_MAX, PTRDIFF_MAX) - 1)) - STRING_BYTES_BOUND; /* Mark STR as a unibyte string. */ #define STRING_SET_UNIBYTE(STR) \ @@ -1392,6 +1394,35 @@ SAVE_OBJECT }; +/* Number of bits needed to store one of the above values. */ +enum { SAVE_SLOT_BITS = 2 }; + +/* Number of slots in a save value where save_type is nonzero. */ +enum { SAVE_VALUE_SLOTS = 4 }; + +/* Bit-width and values for struct Lisp_Save_Value's save_type member. */ + +enum { SAVE_TYPE_BITS = SAVE_VALUE_SLOTS * SAVE_SLOT_BITS + 1 }; + +enum Lisp_Save_Type + { + SAVE_TYPE_INT_INT = SAVE_INTEGER + (SAVE_INTEGER << SAVE_SLOT_BITS), + SAVE_TYPE_INT_INT_INT + = (SAVE_INTEGER + (SAVE_TYPE_INT_INT << SAVE_SLOT_BITS)), + SAVE_TYPE_OBJ_OBJ = SAVE_OBJECT + (SAVE_OBJECT << SAVE_SLOT_BITS), + SAVE_TYPE_OBJ_OBJ_OBJ = SAVE_OBJECT + (SAVE_TYPE_OBJ_OBJ << SAVE_SLOT_BITS), + SAVE_TYPE_OBJ_OBJ_OBJ_OBJ + = SAVE_OBJECT + (SAVE_TYPE_OBJ_OBJ_OBJ << SAVE_SLOT_BITS), + SAVE_TYPE_PTR_INT = SAVE_POINTER + (SAVE_INTEGER << SAVE_SLOT_BITS), + SAVE_TYPE_PTR_OBJ = SAVE_POINTER + (SAVE_OBJECT << SAVE_SLOT_BITS), + SAVE_TYPE_PTR_PTR = SAVE_POINTER + (SAVE_POINTER << SAVE_SLOT_BITS), + SAVE_TYPE_PTR_PTR_OBJ + = SAVE_POINTER + (SAVE_TYPE_PTR_OBJ << SAVE_SLOT_BITS), + + /* This has an extra bit indicating it's raw memory. */ + SAVE_TYPE_MEMORY = SAVE_TYPE_PTR_INT + (1 << (SAVE_TYPE_BITS - 1)) + }; + /* Special object used to hold a different values for later use. This is mostly used to package C integers and pointers to call @@ -1412,73 +1443,96 @@ If yon need to pass more than just one C pointer, you should use make_save_value. This function allows you to pack up to - 4 integers, pointers or Lisp_Objects and conveniently get them - back with XSAVE_POINTER, XSAVE_INTEGER and XSAVE_OBJECT macros: + SAVE_VALUE_SLOTS integers, pointers or Lisp_Objects and + conveniently get them back with XSAVE_POINTER, XSAVE_INTEGER and + XSAVE_OBJECT macros: ... struct my_data *md = get_my_data (); - ptrdiff_t my_offset = get_my_offset (); Lisp_Object my_object = get_my_object (); record_unwind_protect - (my_unwind, make_save_value ("pio", md, my_offset, my_object)); + (my_unwind, make_save_value (SAVE_TYPE_PTR_OBJ, md, my_object)); ... Lisp_Object my_unwind (Lisp_Object arg) { struct my_data *md = XSAVE_POINTER (arg, 0); - ptrdiff_t my_offset = XSAVE_INTEGER (arg, 1); - Lisp_Object my_object = XSAVE_OBJECT (arg, 2); + Lisp_Object my_object = XSAVE_OBJECT (arg, 1); ... } If ENABLE_CHECKING is in effect, XSAVE_xxx macros do type checking of the saved objects and raise eassert if type of the saved object doesn't match the type which is extracted. In the example above, XSAVE_INTEGER (arg, 2) - or XSAVE_OBJECT (arg, 1) are wrong because integer was saved in slot 1 and - Lisp_Object was saved in slot 2 of ARG. */ + or XSAVE_OBJECT (arg, 0) are wrong because nothing was saved in slot 2 and + Lisp_Object was saved in slot 1 of ARG. */ struct Lisp_Save_Value { ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Save_Value */ unsigned gcmarkbit : 1; - int spacer : 6; - /* If `area' is nonzero, `data[0].pointer' is the address of a memory area - containing `data[1].integer' potential Lisp_Objects. The rest of `data' - fields are unused. */ - unsigned area : 1; - /* If `area' is zero, `data[N]' may hold different objects which type is - encoded in `typeN' fields as described by the anonymous enum above. - E.g. if `type0' is SAVE_INTEGER, `data[0].integer' is in use. */ - unsigned type0 : 2; - unsigned type1 : 2; - unsigned type2 : 2; - unsigned type3 : 2; + int spacer : 32 - (16 + 1 + SAVE_TYPE_BITS); + + /* DATA[N] may hold up to SAVE_VALUE_SLOTS entries. The type of + V's Ith entry is given by save_type (V, I). E.g., if save_type + (V, 3) == SAVE_INTEGER, V->data[3].integer is in use. + + If SAVE_TYPE == SAVE_TYPE_MEMORY, DATA[0].pointer is the address of + a memory area containing DATA[1].integer potential Lisp_Objects. */ + ENUM_BF (Lisp_Save_Type) save_type : SAVE_TYPE_BITS; union { void *pointer; ptrdiff_t integer; Lisp_Object object; - } data[4]; + } data[SAVE_VALUE_SLOTS]; }; -/* Macro to set and extract Nth saved pointer. Type - checking is ugly because it's used as an lvalue. */ - -#define XSAVE_POINTER(obj, n) \ - XSAVE_VALUE (obj)->data[(eassert (XSAVE_VALUE (obj)->type \ - ## n == SAVE_POINTER), n)].pointer +/* Return the type of V's Nth saved value. */ +LISP_INLINE int +save_type (struct Lisp_Save_Value *v, int n) +{ + eassert (0 <= n && n < SAVE_VALUE_SLOTS); + return (v->save_type >> (SAVE_SLOT_BITS * n) & ((1 << SAVE_SLOT_BITS) - 1)); +} + +/* Get and set the Nth saved pointer. */ + +LISP_INLINE void * +XSAVE_POINTER (Lisp_Object obj, int n) +{ + eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER); + return XSAVE_VALUE (obj)->data[n].pointer;; +} +LISP_INLINE void +set_save_pointer (Lisp_Object obj, int n, void *val) +{ + eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER); + XSAVE_VALUE (obj)->data[n].pointer = val; +} /* Likewise for the saved integer. */ -#define XSAVE_INTEGER(obj, n) \ - XSAVE_VALUE (obj)->data[(eassert (XSAVE_VALUE (obj)->type \ - ## n == SAVE_INTEGER), n)].integer - -/* Macro to extract Nth saved object. This is never used as - an lvalue, so we can do more convenient type checking. */ - -#define XSAVE_OBJECT(obj, n) \ - (eassert (XSAVE_VALUE (obj)->type ## n == SAVE_OBJECT), \ - XSAVE_VALUE (obj)->data[n].object) +LISP_INLINE ptrdiff_t +XSAVE_INTEGER (Lisp_Object obj, int n) +{ + eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER); + return XSAVE_VALUE (obj)->data[n].integer; +} +LISP_INLINE void +set_save_integer (Lisp_Object obj, int n, ptrdiff_t val) +{ + eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER); + XSAVE_VALUE (obj)->data[n].integer = val; +} + +/* Extract Nth saved object. */ + +LISP_INLINE Lisp_Object +XSAVE_OBJECT (Lisp_Object obj, int n) +{ + eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_OBJECT); + return XSAVE_VALUE (obj)->data[n].object; +} /* A miscellaneous object, when it's on the free list. */ struct Lisp_Free @@ -1501,6 +1555,13 @@ struct Lisp_Save_Value u_save_value; }; +LISP_INLINE struct Lisp_Save_Value * +XSAVE_VALUE (Lisp_Object a) +{ + eassert (SAVE_VALUEP (a)); + return & XMISC (a)->u_save_value; +} + /* Forwarding pointer to an int variable. This is allowed only in the value cell of a symbol, and it means that the symbol's value really lives in the @@ -1786,7 +1847,12 @@ #define VECTORP(x) (VECTORLIKEP (x) && !(ASIZE (x) & PSEUDOVECTOR_FLAG)) #define OVERLAYP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay) #define MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker) -#define SAVE_VALUEP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value) + +LISP_INLINE bool +SAVE_VALUEP (Lisp_Object x) +{ + return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value; +} #define AUTOLOADP(x) (CONSP (x) && EQ (Qautoload, XCAR (x))) @@ -3105,7 +3171,7 @@ extern Lisp_Object make_float (double); extern void display_malloc_warning (void); extern ptrdiff_t inhibit_garbage_collection (void); -extern Lisp_Object make_save_value (const char *, ...); +extern Lisp_Object make_save_value (enum Lisp_Save_Type, ...); extern Lisp_Object make_save_pointer (void *); extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object); extern void free_marker (Lisp_Object); @@ -3822,8 +3888,7 @@ { \ Lisp_Object arg_; \ buf = xmalloc ((nelt) * word_size); \ - arg_ = make_save_value ("pi", buf, nelt); \ - XSAVE_VALUE (arg_)->area = 1; \ + arg_ = make_save_value (SAVE_TYPE_MEMORY, buf, nelt); \ sa_must_free = 1; \ record_unwind_protect (safe_alloca_unwind, arg_); \ } \ === modified file 'src/print.c' --- src/print.c 2013-03-19 14:09:05 +0000 +++ src/print.c 2013-03-21 20:56:22 +0000 @@ -2042,17 +2042,15 @@ strout ("#area) + if (v->save_type == SAVE_TYPE_MEMORY) { ptrdiff_t amount = v->data[1].integer; #if GC_MARK_STACK - /* If GC_MARK_STACK, valid_lisp_object_p is quite reliable, - and so we try to print up to 8 objects we have saved. - Although valid_lisp_object_p is slow, this shouldn't be - a real bottleneck because we do not use this code under - normal circumstances. */ + /* valid_lisp_object_p is reliable, so try to print up + to 8 saved objects. This code is rarely used, so + it's OK that valid_lisp_object_p is slow. */ int limit = min (amount, 8); Lisp_Object *area = v->data[0].pointer; @@ -2077,9 +2075,8 @@ #else /* not GC_MARK_STACK */ - /* If !GC_MARK_STACK, we have no reliable way to find - whether Lisp_Object pointers points to an initialized - objects, and so we do not ever trying to print them. */ + /* There is no reliable way to determine whether the objects + are initialized, so do not try to print them. */ i = sprintf (buf, "with %"pD"d objects", amount); strout (buf, i, i, printcharfun); @@ -2088,33 +2085,37 @@ } else { - /* Print each `data[N]' slot according to its type. */ - -#define PRINTX(index) \ - do { \ - i = 0; \ - if (v->type ## index == SAVE_UNUSED) \ - i = sprintf (buf, ""); \ - else if (v->type ## index == SAVE_INTEGER) \ - i = sprintf (buf, "", v->data[index].integer); \ - else if (v->type ## index == SAVE_POINTER) \ - i = sprintf (buf, "", v->data[index].pointer); \ - else /* SAVE_OBJECT */ \ - print_object (v->data[index].object, printcharfun, escapeflag); \ - if (i) \ - strout (buf, i, i, printcharfun); \ - } while (0) - - PRINTX (0); - PRINTCHAR (' '); - PRINTX (1); - PRINTCHAR (' '); - PRINTX (2); - PRINTCHAR (' '); - PRINTX (3); - -#undef PRINTX - + /* Print each slot according to its type. */ + int index; + for (index = 0; index < SAVE_VALUE_SLOTS; index++) + { + if (index) + PRINTCHAR (' '); + + switch (save_type (v, index)) + { + case SAVE_UNUSED: + i = sprintf (buf, ""); + break; + + case SAVE_POINTER: + i = sprintf (buf, "", + v->data[index].pointer); + break; + + case SAVE_INTEGER: + i = sprintf (buf, "", + v->data[index].integer); + break; + + case SAVE_OBJECT: + print_object (v->data[index].object, printcharfun, + escapeflag); + continue; + } + + strout (buf, i, i, printcharfun); + } } PRINTCHAR ('>'); } === modified file 'src/xmenu.c' --- src/xmenu.c 2013-01-17 06:29:40 +0000 +++ src/xmenu.c 2013-03-21 20:56:22 +0000 @@ -2479,7 +2479,7 @@ #endif record_unwind_protect (pop_down_menu, - make_save_value ("pp", f, menu)); + make_save_value (SAVE_TYPE_PTR_PTR, f, menu)); /* Help display under X won't work because XMenuActivate contains a loop that doesn't give Emacs a chance to process it. */ ------------------------------------------------------------ Use --include-merged or -n0 to see merged revisions.