Now on revision 111529. ------------------------------------------------------------ revno: 111529 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2013-01-15 01:05:22 -0500 message: * lisp/emacs-lisp/advice.el (ad-preactivate-advice): Adjust the cleanup to the use of nadvice.el. * lisp/emacs-lisp/nadvice.el (advice--tweak): Make it possible for `tweak' to return an explicit nil. (advice--remove-function): Change accordingly. * test/automated/advice-tests.el: Split up. Add advice-test-preactivate. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-01-15 04:20:13 +0000 +++ lisp/ChangeLog 2013-01-15 06:05:22 +0000 @@ -1,5 +1,12 @@ 2013-01-15 Stefan Monnier + * emacs-lisp/nadvice.el (advice--tweak): Make it possible for `tweak' + to return an explicit nil. + (advice--remove-function): Change accordingly. + + * emacs-lisp/advice.el (ad-preactivate-advice): Adjust the cleanup to + the use of nadvice.el. + * progmodes/which-func.el (which-function): Silence imenu errors (bug#13433). === modified file 'lisp/emacs-lisp/advice.el' --- lisp/emacs-lisp/advice.el 2013-01-08 15:24:56 +0000 +++ lisp/emacs-lisp/advice.el 2013-01-15 06:05:22 +0000 @@ -2866,10 +2866,8 @@ (defun ad-preactivate-advice (function advice class position) "Preactivate FUNCTION and returns the constructed cache." - (let* ((function-defined-p (fboundp function)) - (old-definition - (if function-defined-p - (symbol-function function))) + (let* ((advicefunname (ad-get-advice-info-field function 'advicefunname)) + (old-advice (symbol-function advicefunname)) (old-advice-info (ad-copy-advice-info function)) (ad-advised-functions ad-advised-functions)) (unwind-protect @@ -2883,10 +2881,9 @@ (list (ad-get-cache-definition function) (ad-get-cache-id function)))) (ad-set-advice-info function old-advice-info) - ;; Don't `fset' function to nil if it was previously unbound: - (if function-defined-p - (fset function old-definition) - (fmakunbound function))))) + (advice-remove function advicefunname) + (fset advicefunname old-advice) + (if old-advice (advice-add function :around advicefunname))))) ;; @@ Activation and definition handling: === modified file 'lisp/emacs-lisp/nadvice.el' --- lisp/emacs-lisp/nadvice.el 2013-01-08 15:24:56 +0000 +++ lisp/emacs-lisp/nadvice.el 2013-01-15 06:05:22 +0000 @@ -173,20 +173,21 @@ (let ((first (advice--car flist)) (rest (advice--cdr flist)) (props (advice--props flist))) - (or (funcall tweaker first rest props) + (let ((val (funcall tweaker first rest props))) + (if val (car val) (let ((nrest (advice--tweak rest tweaker))) (if (eq rest nrest) flist (advice--make-1 (aref flist 1) (aref flist 3) - first nrest props))))))) + first nrest props)))))))) ;;;###autoload (defun advice--remove-function (flist function) (advice--tweak flist (lambda (first rest props) - (if (or (not first) - (equal function first) + (cond ((not first) rest) + ((or (equal function first) (equal function (cdr (assq 'name props)))) - rest)))) + (list rest)))))) (defvar advice--buffer-local-function-sample nil) === modified file 'test/ChangeLog' --- test/ChangeLog 2013-01-14 01:08:13 +0000 +++ test/ChangeLog 2013-01-15 06:05:22 +0000 @@ -1,3 +1,7 @@ +2013-01-15 Stefan Monnier + + * automated/advice-tests.el: Split up. Add advice-test-preactivate. + 2013-01-14 Glenn Morris * automated/compile-tests.el (compile-tests--test-regexps-data): === modified file 'test/automated/advice-tests.el' --- test/automated/advice-tests.el 2013-01-07 18:03:01 +0000 +++ test/automated/advice-tests.el 2013-01-15 06:05:22 +0000 @@ -21,99 +21,112 @@ ;;; Code: -(ert-deftest advice-tests () +(ert-deftest advice-tests-nadvice () + "Test nadvice code." + (defun sm-test1 (x) (+ x 4)) + (should (equal (sm-test1 6) 10)) + (advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 5))) + (should (equal (sm-test1 6) 50)) + (defun sm-test1 (x) (+ x 14)) + (should (equal (sm-test1 6) 100)) + (should (equal (null (get 'sm-test1 'defalias-fset-function)) nil)) + (advice-remove 'sm-test1 (lambda (f y) (* (funcall f y) 5))) + (should (equal (sm-test1 6) 20)) + (should (equal (get 'sm-test1 'defalias-fset-function) nil)) + + (advice-add 'sm-test3 :around + (lambda (f &rest args) `(toto ,(apply f args))) + '((name . wrap-with-toto))) + (defmacro sm-test3 (x) `(call-test3 ,x)) + (should (equal (macroexpand '(sm-test3 56)) '(toto (call-test3 56))))) + +(ert-deftest advice-tests-advice () "Test advice code." - (with-temp-buffer - (defun sm-test1 (x) (+ x 4)) - (should (equal (sm-test1 6) 10)) - (advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 5))) - (should (equal (sm-test1 6) 50)) - (defun sm-test1 (x) (+ x 14)) - (should (equal (sm-test1 6) 100)) - (should (equal (null (get 'sm-test1 'defalias-fset-function)) nil)) - (advice-remove 'sm-test1 (lambda (f y) (* (funcall f y) 5))) - (should (equal (sm-test1 6) 20)) - (should (equal (null (get 'sm-test1 'defalias-fset-function)) t)) - - (defun sm-test2 (x) (+ x 4)) - (should (equal (sm-test2 6) 10)) - (defadvice sm-test2 (around sm-test activate) - ad-do-it (setq ad-return-value (* ad-return-value 5))) - (should (equal (sm-test2 6) 50)) - (ad-deactivate 'sm-test2) - (should (equal (sm-test2 6) 10)) - (ad-activate 'sm-test2) - (should (equal (sm-test2 6) 50)) - (defun sm-test2 (x) (+ x 14)) - (should (equal (sm-test2 6) 100)) - (should (equal (null (get 'sm-test2 'defalias-fset-function)) nil)) - (ad-remove-advice 'sm-test2 'around 'sm-test) - (should (equal (sm-test2 6) 100)) - (ad-activate 'sm-test2) - (should (equal (sm-test2 6) 20)) - (should (equal (null (get 'sm-test2 'defalias-fset-function)) t)) - - (advice-add 'sm-test3 :around - (lambda (f &rest args) `(toto ,(apply f args))) - '((name . wrap-with-toto))) - (defmacro sm-test3 (x) `(call-test3 ,x)) - (should (equal (macroexpand '(sm-test3 56)) '(toto (call-test3 56)))) - - (defadvice sm-test4 (around wrap-with-toto activate) - ad-do-it (setq ad-return-value `(toto ,ad-return-value))) - (defmacro sm-test4 (x) `(call-test4 ,x)) - (should (equal (macroexpand '(sm-test4 56)) '(toto (call-test4 56)))) - (defmacro sm-test4 (x) `(call-testq ,x)) - (should (equal (macroexpand '(sm-test4 56)) '(toto (call-testq 56)))) - - ;; Combining old style and new style advices. - (defun sm-test5 (x) (+ x 4)) - (should (equal (sm-test5 6) 10)) - (advice-add 'sm-test5 :around (lambda (f y) (* (funcall f y) 5))) - (should (equal (sm-test5 6) 50)) - (defadvice sm-test5 (around test activate) - ad-do-it (setq ad-return-value (+ ad-return-value 0.1))) - (should (equal (sm-test5 5) 45.1)) - (ad-deactivate 'sm-test5) - (should (equal (sm-test5 6) 50)) - (ad-activate 'sm-test5) - (should (equal (sm-test5 6) 50.1)) - (defun sm-test5 (x) (+ x 14)) - (should (equal (sm-test5 6) 100.1)) - (advice-remove 'sm-test5 (lambda (f y) (* (funcall f y) 5))) - (should (equal (sm-test5 6) 20.1)) - - ;; This used to signal an error (bug#12858). - (autoload 'sm-test6 "foo") - (defadvice sm-test6 (around test activate) - ad-do-it) - - ;; Check interaction between advice and called-interactively-p. - (defun sm-test7 (&optional x) (interactive) (+ (or x 7) 4)) - (advice-add 'sm-test7 :around - (lambda (f &rest args) - (list (cons 1 (called-interactively-p)) (apply f args)))) - (should (equal (sm-test7) '((1 . nil) 11))) - (should (equal (call-interactively 'sm-test7) '((1 . t) 11))) - (let ((smi 7)) - (advice-add 'sm-test7 :before - (lambda (&rest args) - (setq smi (called-interactively-p)))) - (should (equal (list (sm-test7) smi) - '(((1 . nil) 11) nil))) - (should (equal (list (call-interactively 'sm-test7) smi) - '(((1 . t) 11) t)))) - (advice-add 'sm-test7 :around - (lambda (f &rest args) - (cons (cons 2 (called-interactively-p)) (apply f args)))) - (should (equal (call-interactively 'sm-test7) '((2 . t) (1 . t) 11))) - - ;; Check handling of interactive spec. - (defun sm-test8 (a) (interactive "p") a) - (defadvice sm-test8 (before adv1 activate) nil) - (defadvice sm-test8 (before adv2 activate) (interactive "P") nil) - (should (equal (interactive-form 'sm-test8) '(interactive "P"))) - )) + (defun sm-test2 (x) (+ x 4)) + (should (equal (sm-test2 6) 10)) + (defadvice sm-test2 (around sm-test activate) + ad-do-it (setq ad-return-value (* ad-return-value 5))) + (should (equal (sm-test2 6) 50)) + (ad-deactivate 'sm-test2) + (should (equal (sm-test2 6) 10)) + (ad-activate 'sm-test2) + (should (equal (sm-test2 6) 50)) + (defun sm-test2 (x) (+ x 14)) + (should (equal (sm-test2 6) 100)) + (should (equal (null (get 'sm-test2 'defalias-fset-function)) nil)) + (ad-remove-advice 'sm-test2 'around 'sm-test) + (should (equal (sm-test2 6) 100)) + (ad-activate 'sm-test2) + (should (equal (sm-test2 6) 20)) + (should (equal (null (get 'sm-test2 'defalias-fset-function)) t)) + + (defadvice sm-test4 (around wrap-with-toto activate) + ad-do-it (setq ad-return-value `(toto ,ad-return-value))) + (defmacro sm-test4 (x) `(call-test4 ,x)) + (should (equal (macroexpand '(sm-test4 56)) '(toto (call-test4 56)))) + (defmacro sm-test4 (x) `(call-testq ,x)) + (should (equal (macroexpand '(sm-test4 56)) '(toto (call-testq 56)))) + + ;; This used to signal an error (bug#12858). + (autoload 'sm-test6 "foo") + (defadvice sm-test6 (around test activate) + ad-do-it)) + +(ert-deftest advice-tests-combination () + "Combining old style and new style advices." + (defun sm-test5 (x) (+ x 4)) + (should (equal (sm-test5 6) 10)) + (advice-add 'sm-test5 :around (lambda (f y) (* (funcall f y) 5))) + (should (equal (sm-test5 6) 50)) + (defadvice sm-test5 (around test activate) + ad-do-it (setq ad-return-value (+ ad-return-value 0.1))) + (should (equal (sm-test5 5) 45.1)) + (ad-deactivate 'sm-test5) + (should (equal (sm-test5 6) 50)) + (ad-activate 'sm-test5) + (should (equal (sm-test5 6) 50.1)) + (defun sm-test5 (x) (+ x 14)) + (should (equal (sm-test5 6) 100.1)) + (advice-remove 'sm-test5 (lambda (f y) (* (funcall f y) 5))) + (should (equal (sm-test5 6) 20.1))) + +(ert-deftest advice-test-called-interactively-p () + "Check interaction between advice and called-interactively-p." + (defun sm-test7 (&optional x) (interactive) (+ (or x 7) 4)) + (advice-add 'sm-test7 :around + (lambda (f &rest args) + (list (cons 1 (called-interactively-p)) (apply f args)))) + (should (equal (sm-test7) '((1 . nil) 11))) + (should (equal (call-interactively 'sm-test7) '((1 . t) 11))) + (let ((smi 7)) + (advice-add 'sm-test7 :before + (lambda (&rest args) + (setq smi (called-interactively-p)))) + (should (equal (list (sm-test7) smi) + '(((1 . nil) 11) nil))) + (should (equal (list (call-interactively 'sm-test7) smi) + '(((1 . t) 11) t)))) + (advice-add 'sm-test7 :around + (lambda (f &rest args) + (cons (cons 2 (called-interactively-p)) (apply f args)))) + (should (equal (call-interactively 'sm-test7) '((2 . t) (1 . t) 11)))) + +(ert-deftest advice-test-interactive () + "Check handling of interactive spec." + (defun sm-test8 (a) (interactive "p") a) + (defadvice sm-test8 (before adv1 activate) nil) + (defadvice sm-test8 (before adv2 activate) (interactive "P") nil) + (should (equal (interactive-form 'sm-test8) '(interactive "P")))) + +(ert-deftest advice-test-preactivate () + (should (equal (null (get 'sm-test9 'defalias-fset-function)) t)) + (defun sm-test9 (a) (interactive "p") a) + (should (equal (null (get 'sm-test9 'defalias-fset-function)) t)) + (defadvice sm-test9 (before adv1 pre act protect compile) nil) + (should (equal (null (get 'sm-test9 'defalias-fset-function)) nil)) + (defadvice sm-test9 (before adv2 pre act protect compile) + (interactive "P") nil) + (should (equal (interactive-form 'sm-test9) '(interactive "P")))) ;; Local Variables: ;; no-byte-compile: t ------------------------------------------------------------ revno: 111528 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2013-01-14 23:26:28 -0500 message: * lisp/gnus/nnimap.el (nnimap-keepalive): Don't throw an error if there's no more imap process running. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2013-01-14 22:09:16 +0000 +++ lisp/gnus/ChangeLog 2013-01-15 04:26:28 +0000 @@ -1,7 +1,12 @@ +2013-01-15 Stefan Monnier + + * nnimap.el (nnimap-keepalive): Don't throw an error if there's no more + imap process running. + 2013-01-14 Julien Danjou - * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Compare - addresses against addresses, not against the full From field. + * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): + Compare addresses against addresses, not against the full From field. 2013-01-13 Richard Stallman @@ -178,8 +183,8 @@ the `face' property with a list whose car is the face specified in the format string and whose cdr is (nil). * lisp/gnus-util.el - (gnus-put-text-property-excluding-characters-with-faces): Change - accordingly. + (gnus-put-text-property-excluding-characters-with-faces): + Change accordingly. (gnus-get-text-property-excluding-characters-with-faces): New function. * lisp/gnus-sum.el (gnus-summary-highlight-line): * lisp/gnus-salt.el (gnus-tree-highlight-node): @@ -227,8 +232,8 @@ 2012-12-22 Philipp Haselwarter - * gnus-sync.el (gnus-sync-file-encrypt-to, gnus-sync-save): Set - epa-file-encrypt-to from variable to avoid querying. + * gnus-sync.el (gnus-sync-file-encrypt-to, gnus-sync-save): + Set epa-file-encrypt-to from variable to avoid querying. 2012-12-14 Akinori MUSHA (tiny change) === modified file 'lisp/gnus/nnimap.el' --- lisp/gnus/nnimap.el 2013-01-02 16:13:04 +0000 +++ lisp/gnus/nnimap.el 2013-01-15 04:26:28 +0000 @@ -339,7 +339,8 @@ (nnimap-last-command-time nnimap-object))) ;; More than five minutes since the last command. (* 5 60))) - (nnimap-send-command "NOOP"))))))) + (ignore-errors ;E.g. "buffer foo has no process". + (nnimap-send-command "NOOP")))))))) (defun nnimap-open-connection (buffer) ;; Be backwards-compatible -- the earlier value of nnimap-stream was @@ -367,7 +368,7 @@ (defun nnimap-open-connection-1 (buffer) (unless nnimap-keepalive-timer (setq nnimap-keepalive-timer (run-at-time (* 60 15) (* 60 15) - 'nnimap-keepalive))) + #'nnimap-keepalive))) (with-current-buffer (nnimap-make-process-buffer buffer) (let* ((coding-system-for-read 'binary) (coding-system-for-write 'binary) ------------------------------------------------------------ revno: 111527 fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=13433 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2013-01-14 23:20:13 -0500 message: * lisp/progmodes/which-func.el (which-function): Silence imenu errors. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-01-15 03:21:56 +0000 +++ lisp/ChangeLog 2013-01-15 04:20:13 +0000 @@ -1,6 +1,11 @@ +2013-01-15 Stefan Monnier + + * progmodes/which-func.el (which-function): Silence imenu errors + (bug#13433). + 2013-01-15 Michael R. Mauger - * progmodes/sql.el: (sql-imenu-generic-expression): + * progmodes/sql.el: (sql-imenu-generic-expression): (sql-mode-font-lock-object-name): Match schema qualified names. (sql-connect): Use string keys. (sql-product-interactive): Wait for interpreter prompt. @@ -9,9 +14,8 @@ 2013-01-15 Michael R. Mauger * progmodes/sql.el (sql-output-to-send): Remove, unused. - (sql-interactive-remove-continuation-prompt): - (sql-send-magic-terminator, sql-interactive-mode): Remove - references. + (sql-interactive-remove-continuation-prompt): + (sql-send-magic-terminator, sql-interactive-mode): Remove references. 2013-01-14 Leo Liu @@ -25,22 +29,21 @@ 2013-01-13 Fabián Ezequiel Gallina - * progmodes/python.el (python-nav-end-of-statement): Fix - cornercase when handling multiline strings. + * progmodes/python.el (python-nav-end-of-statement): + Fix cornercase when handling multiline strings. 2013-01-13 Richard Stallman * mail/sendmail.el (mail-position-on-field): Add doc string. - * mail/rmailmm.el (rmail-insert-mime-forwarded-message): Get - current message boundaries and pass them to + * mail/rmailmm.el (rmail-insert-mime-forwarded-message): + Get current message boundaries and pass them to message-forward-make-body-mime. Minor style changes. 2013-01-13 Eli Zaretskii * cus-start.el (all): Avoid warnings about - scroll-bar-adjust-thumb-portion on platforms where it is not - defined. + scroll-bar-adjust-thumb-portion on platforms where it is not defined. 2013-01-11 Jan Djärv === modified file 'lisp/progmodes/which-func.el' --- lisp/progmodes/which-func.el 2013-01-10 15:36:01 +0000 +++ lisp/progmodes/which-func.el 2013-01-15 04:20:13 +0000 @@ -290,7 +290,7 @@ (when (and (null name) (boundp 'imenu--index-alist) (null imenu--index-alist) (null which-function-imenu-failed)) - (imenu--make-index-alist t) + (ignore-errors (imenu--make-index-alist t)) (unless imenu--index-alist (set (make-local-variable 'which-function-imenu-failed) t))) ;; If we have an index alist, use it. ------------------------------------------------------------ revno: 111526 committer: Michael Mauger branch nick: trunk timestamp: Mon 2013-01-14 22:21:56 -0500 message: * progmodes/sql.el: (sql-imenu-generic-expression): (sql-mode-font-lock-object-name): Match schema qualified names. (sql-connect): Use string keys. (sql-product-interactive): Wait for interpreter prompt. (sql-comint-oracle): Set process coding based on NLS_LANG. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-01-15 02:35:45 +0000 +++ lisp/ChangeLog 2013-01-15 03:21:56 +0000 @@ -1,5 +1,13 @@ 2013-01-15 Michael R. Mauger + * progmodes/sql.el: (sql-imenu-generic-expression): + (sql-mode-font-lock-object-name): Match schema qualified names. + (sql-connect): Use string keys. + (sql-product-interactive): Wait for interpreter prompt. + (sql-comint-oracle): Set process coding based on NLS_LANG. + +2013-01-15 Michael R. Mauger + * progmodes/sql.el (sql-output-to-send): Remove, unused. (sql-interactive-remove-continuation-prompt): (sql-send-magic-terminator, sql-interactive-mode): Remove === modified file 'lisp/progmodes/sql.el' --- lisp/progmodes/sql.el 2013-01-15 02:35:45 +0000 +++ lisp/progmodes/sql.el 2013-01-15 03:21:56 +0000 @@ -723,15 +723,15 @@ (defvar sql-imenu-generic-expression ;; Items are in reverse order because they are rendered in reverse. - '(("Rules/Defaults" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*\\(?:rule\\|default\\)\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\s-+\\(\\w+\\)" 1) - ("Sequences" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*sequence\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\w+\\)" 1) - ("Triggers" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*trigger\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\w+\\)" 1) - ("Functions" "^\\s-*\\(?:create\\s-+\\(?:\\w+\\s-+\\)*\\)?function\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\w+\\)" 1) - ("Procedures" "^\\s-*\\(?:create\\s-+\\(?:\\w+\\s-+\\)*\\)?proc\\(?:edure\\)?\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\w+\\)" 1) - ("Packages" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*package\\s-+\\(?:body\\s-+\\)?\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\w+\\)" 1) - ("Types" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*type\\s-+\\(?:body\\s-+\\)?\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\w+\\)" 1) - ("Indexes" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*index\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\w+\\)" 1) - ("Tables/Views" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*\\(?:table\\|view\\)\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\w+\\)" 1)) + '(("Rules/Defaults" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*\\(?:rule\\|default\\)\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\s-+\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1) + ("Sequences" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*sequence\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1) + ("Triggers" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*trigger\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1) + ("Functions" "^\\s-*\\(?:create\\s-+\\(?:\\w+\\s-+\\)*\\)?function\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1) + ("Procedures" "^\\s-*\\(?:create\\s-+\\(?:\\w+\\s-+\\)*\\)?proc\\(?:edure\\)?\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1) + ("Packages" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*package\\s-+\\(?:body\\s-+\\)?\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1) + ("Types" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*type\\s-+\\(?:body\\s-+\\)?\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1) + ("Indexes" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*index\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1) + ("Tables/Views" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*\\(?:table\\|view\\)\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1)) "Define interesting points in the SQL buffer for `imenu'. This is used to set `imenu-generic-expression' when SQL mode is @@ -1313,7 +1313,7 @@ "\\(?:table\\|view\\|\\(?:package\\|type\\)\\(?:\\s-+body\\)?\\|proc\\(?:edure\\)?" "\\|function\\|trigger\\|sequence\\|rule\\|default\\)\\s-+" "\\(?:if\\s-+not\\s-+exists\\s-+\\)?" ;; IF NOT EXISTS - "\\(\\w+\\)") + "\\(\\w+\\(?:\\s-*[.]\\s-*\\w+\\)*\\)") 1 'font-lock-function-name-face)) "Pattern to match the names of top-level objects. @@ -3924,7 +3924,7 @@ ;; Was one selected (when connection ;; Get connection settings - (let ((connect-set (assoc connection sql-connection-alist))) + (let ((connect-set (assoc-string connection sql-connection-alist t))) ;; Settings are defined (if connect-set ;; Set the desired parameters @@ -4128,9 +4128,17 @@ (setq sql-buffer (buffer-name new-sqli-buffer)) (run-hooks 'sql-set-sqli-hook))) + ;; Make sure the connection is complete + ;; (Sometimes start up can be slow) + ;; and call the login hook + (let ((proc (get-buffer-process new-sqli-buffer))) + (while (and (memq (process-status proc) '(open run)) + (accept-process-output proc 2.5) + (progn (goto-char (point-max)) + (not (looking-back sql-prompt-regexp)))))) + (run-hooks 'sql-login-hook) ;; All done. (message "Login...done") - (run-hooks 'sql-login-hook) (pop-to-buffer new-sqli-buffer))))) (message "No default SQL product defined. Set `sql-product'."))) @@ -4196,7 +4204,7 @@ ;; is meaningless; database without user/password is meaningless, ;; because "@param" will ask sqlplus to interpret the script ;; "param". - (let ((parameter nil)) + (let (parameter nlslang coding) (if (not (string= "" sql-user)) (if (not (string= "" sql-password)) (setq parameter (concat sql-user "/" sql-password)) @@ -4206,7 +4214,29 @@ (if parameter (setq parameter (nconc (list parameter) options)) (setq parameter options)) - (sql-comint product parameter))) + (sql-comint product parameter) + ;; Set process coding system to agree with the interpreter + (setq nlslang (or (getenv "NLS_LANG") "") + coding (dolist (cs + ;; Are we missing any common NLS character sets + '(("US8PC437" . cp437) + ("EL8PC737" . cp737) + ("WE8PC850" . cp850) + ("EE8PC852" . cp852) + ("TR8PC857" . cp857) + ("WE8PC858" . cp858) + ("IS8PC861" . cp861) + ("IW8PC1507" . cp862) + ("N8PC865" . cp865) + ("RU8PC866" . cp866) + ("US7ASCII" . us-ascii) + ("UTF8" . utf-8) + ("AL32UTF8" . utf-8) + ("AL16UTF16" . utf-16)) + (or coding 'utf-8)) + (when (string-match (format "\\.%s\\'" (car cs)) nlslang) + (setq coding (cdr cs))))) + (set-buffer-process-coding-system coding coding))) (defun sql-oracle-save-settings (sqlbuf) "Save most SQL*Plus settings so they may be reset by \\[sql-redirect]." ------------------------------------------------------------ revno: 111525 committer: Michael Mauger branch nick: trunk timestamp: Mon 2013-01-14 21:35:45 -0500 message: * progmodes/sql.el (sql-output-to-send): Remove, unused. (sql-interactive-remove-continuation-prompt): (sql-send-magic-terminator, sql-interactive-mode): Remove references. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-01-14 15:39:04 +0000 +++ lisp/ChangeLog 2013-01-15 02:35:45 +0000 @@ -1,3 +1,10 @@ +2013-01-15 Michael R. Mauger + + * progmodes/sql.el (sql-output-to-send): Remove, unused. + (sql-interactive-remove-continuation-prompt): + (sql-send-magic-terminator, sql-interactive-mode): Remove + references. + 2013-01-14 Leo Liu * calendar/calendar.el (calendar-redraw): Sync window-point and point. === modified file 'lisp/progmodes/sql.el' --- lisp/progmodes/sql.el 2013-01-02 16:13:04 +0000 +++ lisp/progmodes/sql.el 2013-01-15 02:35:45 +0000 @@ -3219,9 +3219,6 @@ Allows the suppression of continuation prompts.") -(defvar sql-output-by-send nil - "Non-nil if the command in the input was generated by `sql-send-string'.") - (defun sql-input-sender (proc string) "Send STRING to PROC after applying filters." @@ -3288,8 +3285,7 @@ (if (= sql-output-newline-count 0) (setq sql-output-newline-count nil - oline (concat "\n" oline) - sql-output-by-send nil) + oline (concat "\n" oline)) (setq sql-preoutput-hold oline oline "")) @@ -3383,8 +3379,7 @@ (setq sql-output-newline-count (if sql-output-newline-count (1+ sql-output-newline-count) - 1))) - (setq sql-output-by-send t))) + 1))))) (defun sql-remove-tabs-filter (str) "Replace tab characters with spaces." @@ -3857,7 +3852,6 @@ (sql-get-product-feature sql-product :prompt-cont-regexp)) (make-local-variable 'sql-output-newline-count) (make-local-variable 'sql-preoutput-hold) - (make-local-variable 'sql-output-by-send) (add-hook 'comint-preoutput-filter-functions 'sql-interactive-remove-continuation-prompt nil t) (make-local-variable 'sql-input-ring-separator) ------------------------------------------------------------ revno: 111524 author: Julien Danjou committer: Katsumi Yamaoka branch nick: trunk timestamp: Mon 2013-01-14 22:09:16 +0000 message: gnus-sum.el: gnus-sum: fix `gnus-summary-from-or-to-or-newsgroups' address comparison diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2013-01-13 21:26:10 +0000 +++ lisp/gnus/ChangeLog 2013-01-14 22:09:16 +0000 @@ -1,3 +1,8 @@ +2013-01-14 Julien Danjou + + * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Compare + addresses against addresses, not against the full From field. + 2013-01-13 Richard Stallman * message.el (message-forward-make-body-mime): New args BEG, END @@ -7,10 +12,10 @@ 2013-01-11 Aaron S. Hawley * gnus-start.el (gnus-check-new-newsgroups): Fix ambiguous doc string - cross-reference(s). + cross-reference(s). * gnus-sum.el (gnus-summary-newsgroup-prefix): Fix ambiguous doc string - cross-reference(s). + cross-reference(s). 2013-01-11 Dmitry Antipov === modified file 'lisp/gnus/gnus-sum.el' --- lisp/gnus/gnus-sum.el 2013-01-11 23:08:55 +0000 +++ lisp/gnus/gnus-sum.el 2013-01-14 22:09:16 +0000 @@ -3651,17 +3651,18 @@ (or (car (funcall gnus-extract-address-components from)) from)) -(defun gnus-summary-from-or-to-or-newsgroups (header gnus-tmp-from) +(defun gnus-summary-from-or-to-or-newsgroups (header from) (let ((mail-parse-charset gnus-newsgroup-charset) - (ignored-from-addresses (gnus-ignored-from-addresses)) - ; Is it really necessary to do this next part for each summary line? - ; Luckily, doesn't seem to slow things down much. - (mail-parse-ignored-charsets - (with-current-buffer gnus-summary-buffer - gnus-newsgroup-ignored-charsets))) + (ignored-from-addresses (gnus-ignored-from-addresses)) + ;; Is it really necessary to do this next part for each summary line? + ;; Luckily, doesn't seem to slow things down much. + (mail-parse-ignored-charsets + (with-current-buffer gnus-summary-buffer + gnus-newsgroup-ignored-charsets)) + (address (cadr (gnus-extract-address-components from)))) (or (and ignored-from-addresses - (string-match ignored-from-addresses gnus-tmp-from) + (string-match ignored-from-addresses address) (let ((extra-headers (mail-header-extra header)) to newsgroups) @@ -3680,9 +3681,7 @@ gnus-newsgroup-name)) 'nntp) (gnus-group-real-name gnus-newsgroup-name)))) (concat gnus-summary-newsgroup-prefix newsgroups))))) - (gnus-string-mark-left-to-right - (inline - (gnus-summary-extract-address-component gnus-tmp-from)))))) + (gnus-string-mark-left-to-right (gnus-summary-extract-address-component from))))) (defun gnus-summary-insert-line (gnus-tmp-header gnus-tmp-level gnus-tmp-current ------------------------------------------------------------ revno: 111523 committer: Paul Eggert branch nick: trunk timestamp: Mon 2013-01-14 09:46:14 -0800 message: Avoid needless casts with XSAVE_POINTER. * alloc.c (mark_object) [GC_MARK_STACK]: * dired.c (directory_files_internal_unwind): * fileio.c (do_auto_save_unwind): * gtkutil.c (pop_down_dialog): * keymap.c (map_keymap_char_table_item): * lread.c (load_unwind): * nsmenu.m (pop_down_menu): * print.c (print_object) [GC_MARK_STACK]: * xfns.c (clean_up_file_dialog): * xmenu.c (cleanup_widget_value_tree): Omit casts between XSAVE_POINTER and a pointer type. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-01-14 11:07:50 +0000 +++ src/ChangeLog 2013-01-14 17:46:14 +0000 @@ -1,3 +1,18 @@ +2013-01-14 Paul Eggert + + Avoid needless casts with XSAVE_POINTER. + * alloc.c (mark_object) [GC_MARK_STACK]: + * dired.c (directory_files_internal_unwind): + * fileio.c (do_auto_save_unwind): + * gtkutil.c (pop_down_dialog): + * keymap.c (map_keymap_char_table_item): + * lread.c (load_unwind): + * nsmenu.m (pop_down_menu): + * print.c (print_object) [GC_MARK_STACK]: + * xfns.c (clean_up_file_dialog): + * xmenu.c (cleanup_widget_value_tree): + Omit casts between XSAVE_POINTER and a pointer type. + 2013-01-14 Dmitry Antipov Fix compilation with GC_MARK_STACK == GC_USE_GCPROS_AS_BEFORE. === modified file 'src/alloc.c' --- src/alloc.c 2013-01-14 09:55:21 +0000 +++ src/alloc.c 2013-01-14 17:46:14 +0000 @@ -5943,7 +5943,7 @@ #if GC_MARK_STACK if (ptr->area) { - Lisp_Object *p = (Lisp_Object *) ptr->data[0].pointer; + Lisp_Object *p = ptr->data[0].pointer; ptrdiff_t nelt; for (nelt = ptr->data[1].integer; nelt > 0; nelt--, p++) mark_maybe_object (*p); === modified file 'src/dired.c' --- src/dired.c 2013-01-14 09:55:21 +0000 +++ src/dired.c 2013-01-14 17:46:14 +0000 @@ -78,7 +78,7 @@ static Lisp_Object directory_files_internal_unwind (Lisp_Object dh) { - DIR *d = (DIR *) XSAVE_POINTER (dh); + DIR *d = XSAVE_POINTER (dh); block_input (); closedir (d); unblock_input (); === modified file 'src/fileio.c' --- src/fileio.c 2013-01-14 09:55:21 +0000 +++ src/fileio.c 2013-01-14 17:46:14 +0000 @@ -5507,7 +5507,7 @@ do_auto_save_unwind (Lisp_Object arg) /* used as unwind-protect function */ { - FILE *stream = (FILE *) XSAVE_POINTER (arg); + FILE *stream = XSAVE_POINTER (arg); auto_saving = 0; if (stream != NULL) { === modified file 'src/gtkutil.c' --- src/gtkutil.c 2013-01-14 09:55:21 +0000 +++ src/gtkutil.c 2013-01-14 17:46:14 +0000 @@ -1650,7 +1650,7 @@ static Lisp_Object pop_down_dialog (Lisp_Object arg) { - struct xg_dialog_data *dd = (struct xg_dialog_data *) XSAVE_POINTER (arg); + struct xg_dialog_data *dd = XSAVE_POINTER (arg); block_input (); if (dd->w) gtk_widget_destroy (dd->w); === modified file 'src/keymap.c' --- src/keymap.c 2013-01-14 09:55:21 +0000 +++ src/keymap.c 2013-01-14 17:46:14 +0000 @@ -565,8 +565,7 @@ { if (!NILP (val)) { - map_keymap_function_t fun - = (map_keymap_function_t) XSAVE_POINTER (XCAR (args)); + map_keymap_function_t fun = XSAVE_POINTER (XCAR (args)); args = XCDR (args); /* If the key is a range, make a copy since map_char_table modifies it in place. */ === modified file 'src/lread.c' --- src/lread.c 2013-01-14 09:55:21 +0000 +++ src/lread.c 2013-01-14 17:46:14 +0000 @@ -1357,7 +1357,7 @@ static Lisp_Object load_unwind (Lisp_Object arg) /* Used as unwind-protect function in load. */ { - FILE *stream = (FILE *) XSAVE_POINTER (arg); + FILE *stream = XSAVE_POINTER (arg); if (stream != NULL) { block_input (); === modified file 'src/nsmenu.m' --- src/nsmenu.m 2013-01-14 09:55:21 +0000 +++ src/nsmenu.m 2013-01-14 17:46:14 +0000 @@ -1347,7 +1347,7 @@ static Lisp_Object pop_down_menu (Lisp_Object arg) { - struct Popdown_data *unwind_data = (struct Popdown_data *) XSAVE_POINTER (arg); + struct Popdown_data *unwind_data = XSAVE_POINTER (arg); block_input (); if (popup_activated_flag) === modified file 'src/print.c' --- src/print.c 2013-01-14 09:55:21 +0000 +++ src/print.c 2013-01-14 17:46:14 +0000 @@ -2054,7 +2054,7 @@ normal circumstances. */ int limit = min (amount, 8); - Lisp_Object *area = (Lisp_Object *) v->data[0].pointer; + Lisp_Object *area = v->data[0].pointer; i = sprintf (buf, "with %"pD"d objects", amount); strout (buf, i, i, printcharfun); === modified file 'src/xfns.c' --- src/xfns.c 2013-01-14 09:55:21 +0000 +++ src/xfns.c 2013-01-14 17:46:14 +0000 @@ -5292,7 +5292,7 @@ static Lisp_Object clean_up_file_dialog (Lisp_Object arg) { - Widget dialog = (Widget) XSAVE_POINTER (arg); + Widget dialog = XSAVE_POINTER (arg); /* Clean up. */ block_input (); === modified file 'src/xmenu.c' --- src/xmenu.c 2013-01-14 09:55:21 +0000 +++ src/xmenu.c 2013-01-14 17:46:14 +0000 @@ -1610,7 +1610,7 @@ static Lisp_Object cleanup_widget_value_tree (Lisp_Object arg) { - free_menubar_widget_value_tree ((widget_value *) XSAVE_POINTER (arg)); + free_menubar_widget_value_tree (XSAVE_POINTER (arg)); return Qnil; } ------------------------------------------------------------ revno: 111522 fixes bug: http://debbugs.gnu.org/13420 committer: Leo Liu branch nick: trunk timestamp: Mon 2013-01-14 23:39:04 +0800 message: Sync window-point and point in calendar-redraw diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-01-14 01:08:13 +0000 +++ lisp/ChangeLog 2013-01-14 15:39:04 +0000 @@ -1,3 +1,8 @@ +2013-01-14 Leo Liu + + * calendar/calendar.el (calendar-redraw): Sync window-point and point. + (Bug#13420) + 2013-01-14 Glenn Morris * progmodes/compile.el (compilation-error-regexp-alist-alist): === modified file 'lisp/calendar/calendar.el' --- lisp/calendar/calendar.el 2013-01-01 09:11:05 +0000 +++ lisp/calendar/calendar.el 2013-01-14 15:39:04 +0000 @@ -1562,11 +1562,13 @@ (defun calendar-redraw () "Redraw the calendar display, if `calendar-buffer' is live." (interactive) - (if (get-buffer calendar-buffer) - (with-current-buffer calendar-buffer - (let ((cursor-date (calendar-cursor-to-nearest-date))) - (calendar-generate-window displayed-month displayed-year) - (calendar-cursor-to-visible-date cursor-date))))) + (when (get-buffer calendar-buffer) + (with-current-buffer calendar-buffer + (let ((cursor-date (calendar-cursor-to-nearest-date))) + (calendar-generate-window displayed-month displayed-year) + (calendar-cursor-to-visible-date cursor-date)) + (when (window-live-p (get-buffer-window)) + (set-window-point (get-buffer-window) (point)))))) (defvar calendar-mode-map (let ((map (make-keymap))) ------------------------------------------------------------ revno: 111521 committer: Glenn Morris branch nick: trunk timestamp: Mon 2013-01-14 06:20:54 -0500 message: Auto-commit of loaddefs files. diff: === modified file 'lisp/mail/rmail.el' --- lisp/mail/rmail.el 2013-01-03 19:41:59 +0000 +++ lisp/mail/rmail.el 2013-01-14 11:20:54 +0000 @@ -4647,7 +4647,7 @@ ;;;*** -;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "1f33964668345a1a1f3119fece148227") +;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "93951f748e43e1015da1b485088970ca") ;;; Generated autoloads from rmailmm.el (autoload 'rmail-mime "rmailmm" "\ ------------------------------------------------------------ revno: 111520 committer: Dmitry Antipov branch nick: trunk timestamp: Mon 2013-01-14 15:16:14 +0400 message: * lisp.h (toplevel): Fix typo in comment. diff: === modified file 'src/lisp.h' --- src/lisp.h 2013-01-14 09:55:21 +0000 +++ src/lisp.h 2013-01-14 11:16:14 +0000 @@ -1417,7 +1417,7 @@ #define XSAVE_POINTER(obj) XSAVE_VALUE (obj)->data[0].pointer -/* Likewise for the saved ingeger. */ +/* Likewise for the saved integer. */ #define XSAVE_INTEGER(obj) XSAVE_VALUE (obj)->data[1].integer ------------------------------------------------------------ revno: 111519 committer: Dmitry Antipov branch nick: trunk timestamp: Mon 2013-01-14 15:07:50 +0400 message: Fix compilation with GC_MARK_STACK == GC_USE_GCPROS_AS_BEFORE. * eval.c (eval_sub): Protect `form' from being GCed before its car and cdr becomes protected with the backtrace entry. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-01-14 09:55:21 +0000 +++ src/ChangeLog 2013-01-14 11:07:50 +0000 @@ -1,5 +1,11 @@ 2013-01-14 Dmitry Antipov + Fix compilation with GC_MARK_STACK == GC_USE_GCPROS_AS_BEFORE. + * eval.c (eval_sub): Protect `form' from being GCed before its + car and cdr becomes protected with the backtrace entry. + +2013-01-14 Dmitry Antipov + Make Lisp_Save_Value more versatile storage for up to four objects. * lisp.h (toplevel): Enumeration to describe types of saved objects. (struct Lisp_Save_Value): New layout. Adjust comments. === modified file 'src/eval.c' --- src/eval.c 2013-01-13 20:03:01 +0000 +++ src/eval.c 2013-01-14 11:07:50 +0000 @@ -1931,7 +1931,10 @@ return form; QUIT; + + GCPRO1 (form); maybe_gc (); + UNGCPRO; if (++lisp_eval_depth > max_lisp_eval_depth) { ------------------------------------------------------------ revno: 111518 committer: Dmitry Antipov branch nick: trunk timestamp: Mon 2013-01-14 13:55:21 +0400 message: Make Lisp_Save_Value more versatile storage for up to four objects. * lisp.h (toplevel): Enumeration to describe types of saved objects. (struct Lisp_Save_Value): New layout. Adjust comments. (XSAVE_POINTER): New macro. (XSAVE_INTEGER): Likewise. (allocate_misc): Add prototype. (free_misc): Likewise. * alloc.c (allocate_misc): Now global. (free_misc): Likewise. Adjust comment. (make_save_value): Use new Lisp_Save_Value layout. Adjust comment. (free_save_value): Likewise. (mark_object): Likewise. * editfns.c (save_excursion_save): Pack everything within Lisp_Save_Value and so avoid xmalloc. (save_excursion_restore): Adjust to match new layout. Use free_misc because we do not allocate extra memory any more. Add eassert. * print.c (print_object): New code to print Lisp_Save_Value. Do not rely on valid_lisp_object_p if !GC_MARK_STACK. Adjust comments. * dired.c, fileio.c, font.c, ftfont.c, gtkutil.c, keymap.c, * lread.c, nsmenu.m, nsterm.h, xfns.c, xmenu.c, xselect.c: Use XSAVE_POINTER and XSAVE_INTEGER where appropriate. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-01-13 20:03:01 +0000 +++ src/ChangeLog 2013-01-14 09:55:21 +0000 @@ -1,3 +1,27 @@ +2013-01-14 Dmitry Antipov + + Make Lisp_Save_Value more versatile storage for up to four objects. + * lisp.h (toplevel): Enumeration to describe types of saved objects. + (struct Lisp_Save_Value): New layout. Adjust comments. + (XSAVE_POINTER): New macro. + (XSAVE_INTEGER): Likewise. + (allocate_misc): Add prototype. + (free_misc): Likewise. + * alloc.c (allocate_misc): Now global. + (free_misc): Likewise. Adjust comment. + (make_save_value): Use new Lisp_Save_Value layout. Adjust comment. + (free_save_value): Likewise. + (mark_object): Likewise. + * editfns.c (save_excursion_save): Pack everything within + Lisp_Save_Value and so avoid xmalloc. + (save_excursion_restore): Adjust to match new layout. Use free_misc + because we do not allocate extra memory any more. Add eassert. + * print.c (print_object): New code to print Lisp_Save_Value. Do not + rely on valid_lisp_object_p if !GC_MARK_STACK. Adjust comments. + * dired.c, fileio.c, font.c, ftfont.c, gtkutil.c, keymap.c, + * lread.c, nsmenu.m, nsterm.h, xfns.c, xmenu.c, xselect.c: + Use XSAVE_POINTER and XSAVE_INTEGER where appropriate. + 2013-01-13 Jan Djärv * nsfont.m (LCD_SMOOTHING_MARGIN): New define. === modified file 'src/alloc.c' --- src/alloc.c 2013-01-12 01:47:07 +0000 +++ src/alloc.c 2013-01-14 09:55:21 +0000 @@ -219,7 +219,6 @@ #endif static void compact_small_strings (void); static void free_large_strings (void); -static void free_misc (Lisp_Object); extern Lisp_Object which_symbols (Lisp_Object, EMACS_INT) EXTERNALLY_VISIBLE; /* When scanning the C stack for live Lisp objects, Emacs keeps track of @@ -3303,7 +3302,7 @@ /* Return a newly allocated Lisp_Misc object of specified TYPE. */ -static Lisp_Object +Lisp_Object allocate_misc (enum Lisp_Misc_Type type) { Lisp_Object val; @@ -3339,9 +3338,9 @@ return val; } -/* Free a Lisp_Misc object */ +/* Free a Lisp_Misc object. */ -static void +void free_misc (Lisp_Object misc) { XMISCTYPE (misc) = Lisp_Misc_Free; @@ -3351,9 +3350,10 @@ total_free_markers++; } -/* Return a Lisp_Misc_Save_Value object containing POINTER and - INTEGER. This is used to package C values to call record_unwind_protect. - The unwind function can get the C values back using XSAVE_VALUE. */ +/* Return a Lisp_Save_Value object containing POINTER and INTEGER. + Most code should use this to package C integers and pointers + to call record_unwind_protect. The unwind function can get the + C values back using XSAVE_POINTER and XSAVE_INTEGER. */ Lisp_Object make_save_value (void *pointer, ptrdiff_t integer) @@ -3363,22 +3363,22 @@ val = allocate_misc (Lisp_Misc_Save_Value); p = XSAVE_VALUE (val); - p->pointer = pointer; - p->integer = integer; - p->dogc = 0; + p->type0 = SAVE_POINTER; + p->data[0].pointer = pointer; + p->type1 = SAVE_INTEGER; + p->data[1].integer = integer; + p->type2 = p->type3 = SAVE_UNUSED; + p->area = 0; return val; } -/* Free a Lisp_Misc_Save_Value object. */ +/* Free a Lisp_Save_Value object. Do not use this function + if SAVE contains pointer other than returned by xmalloc. */ void free_save_value (Lisp_Object save) { - register struct Lisp_Save_Value *p = XSAVE_VALUE (save); - - p->dogc = 0; - xfree (p->pointer); - p->pointer = NULL; + xfree (XSAVE_POINTER (save)); free_misc (save); } @@ -5935,20 +5935,33 @@ case Lisp_Misc_Save_Value: XMISCANY (obj)->gcmarkbit = 1; -#if GC_MARK_STACK { register struct Lisp_Save_Value *ptr = XSAVE_VALUE (obj); - /* If DOGC is set, POINTER is the address of a memory - area containing INTEGER potential Lisp_Objects. */ - if (ptr->dogc) + /* If `area' is nonzero, `data[0].pointer' is the address + of a memory area containing `data[1].integer' potential + Lisp_Objects. */ +#if GC_MARK_STACK + if (ptr->area) { - Lisp_Object *p = (Lisp_Object *) ptr->pointer; + Lisp_Object *p = (Lisp_Object *) ptr->data[0].pointer; ptrdiff_t nelt; - for (nelt = ptr->integer; nelt > 0; nelt--, p++) + for (nelt = ptr->data[1].integer; nelt > 0; nelt--, p++) 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); + } } -#endif break; case Lisp_Misc_Overlay: === modified file 'src/dired.c' --- src/dired.c 2013-01-02 16:13:04 +0000 +++ src/dired.c 2013-01-14 09:55:21 +0000 @@ -78,7 +78,7 @@ static Lisp_Object directory_files_internal_unwind (Lisp_Object dh) { - DIR *d = (DIR *) XSAVE_VALUE (dh)->pointer; + DIR *d = (DIR *) XSAVE_POINTER (dh); block_input (); closedir (d); unblock_input (); === modified file 'src/editfns.c' --- src/editfns.c 2013-01-12 01:15:06 +0000 +++ src/editfns.c 2013-01-14 09:55:21 +0000 @@ -833,20 +833,30 @@ Lisp_Object save_excursion_save (void) { - Lisp_Object save, *data = xmalloc (word_size * 4); - - data[0] = Fpoint_marker (); + Lisp_Object save = allocate_misc (Lisp_Misc_Save_Value); + register struct Lisp_Save_Value *v = XSAVE_VALUE (save); + + /* Do not allocate extra space and pack everything in SAVE. */ + v->area = 0; + + v->type0 = SAVE_OBJECT; + v->data[0].object = Fpoint_marker (); + /* Do not copy the mark if it points to nowhere. */ - data[1] = (XMARKER (BVAR (current_buffer, mark))->buffer - ? Fcopy_marker (BVAR (current_buffer, mark), Qnil) - : Qnil); + v->type1 = SAVE_OBJECT; + v->data[1].object = (XMARKER (BVAR (current_buffer, mark))->buffer + ? Fcopy_marker (BVAR (current_buffer, mark), Qnil) + : Qnil); + /* Selected window if current buffer is shown in it, nil otherwise. */ - data[2] = ((XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer) - ? selected_window : Qnil); - data[3] = BVAR (current_buffer, mark_active); - - save = make_save_value (data, 4); - XSAVE_VALUE (save)->dogc = 1; + v->type2 = SAVE_OBJECT; + v->data[2].object + = ((XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer) + ? selected_window : Qnil); + + v->type3 = SAVE_OBJECT; + v->data[3].object = BVAR (current_buffer, mark_active); + return save; } @@ -855,10 +865,15 @@ Lisp_Object save_excursion_restore (Lisp_Object info) { - Lisp_Object tem, tem1, omark, nmark, *data = XSAVE_VALUE (info)->pointer; + Lisp_Object tem, tem1, omark, nmark; struct gcpro gcpro1, gcpro2, gcpro3; - - tem = Fmarker_buffer (data[0]); + register struct Lisp_Save_Value *v = XSAVE_VALUE (info); + + /* Paranoid. */ + eassert (v->type0 == SAVE_OBJECT && v->type1 == SAVE_OBJECT + && v->type2 == SAVE_OBJECT && v->type3 == SAVE_OBJECT); + + tem = Fmarker_buffer (v->data[0].object); /* If we're unwinding to top level, saved buffer may be deleted. This means that all of its markers are unchained and so tem is nil. */ if (NILP (tem)) @@ -870,12 +885,12 @@ Fset_buffer (tem); /* Point marker. */ - tem = data[0]; + tem = v->data[0].object; Fgoto_char (tem); unchain_marker (XMARKER (tem)); /* Mark marker. */ - tem = data[1]; + tem = v->data[1].object; omark = Fmarker_position (BVAR (current_buffer, mark)); if (NILP (tem)) unchain_marker (XMARKER (BVAR (current_buffer, mark))); @@ -887,7 +902,7 @@ } /* Mark active. */ - tem = data[3]; + tem = v->data[3].object; tem1 = BVAR (current_buffer, mark_active); bset_mark_active (current_buffer, tem); @@ -911,7 +926,7 @@ /* If buffer was visible in a window, and a different window was selected, and the old selected window is still showing this buffer, restore point in that window. */ - tem = data[2]; + tem = v->data[2].object; if (WINDOWP (tem) && !EQ (tem, selected_window) && (tem1 = XWINDOW (tem)->buffer, @@ -925,7 +940,7 @@ out: - free_save_value (info); + free_misc (info); return Qnil; } @@ -4258,7 +4273,7 @@ memcpy (buf, initial_buffer, used); } else - XSAVE_VALUE (buf_save_value)->pointer = buf = xrealloc (buf, bufsize); + XSAVE_POINTER (buf_save_value) = buf = xrealloc (buf, bufsize); p = buf + used; } === modified file 'src/fileio.c' --- src/fileio.c 2013-01-04 02:42:08 +0000 +++ src/fileio.c 2013-01-14 09:55:21 +0000 @@ -5507,7 +5507,7 @@ do_auto_save_unwind (Lisp_Object arg) /* used as unwind-protect function */ { - FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer; + FILE *stream = (FILE *) XSAVE_POINTER (arg); auto_saving = 0; if (stream != NULL) { === modified file 'src/font.c' --- src/font.c 2013-01-02 16:13:04 +0000 +++ src/font.c 2013-01-14 09:55:21 +0000 @@ -1857,7 +1857,7 @@ OTF *otf; if (! NILP (val)) - otf = XSAVE_VALUE (XCDR (val))->pointer; + otf = XSAVE_POINTER (XCDR (val)); else { otf = STRINGP (file) ? OTF_open (SSDATA (file)) : NULL; === modified file 'src/ftfont.c' --- src/ftfont.c 2013-01-01 09:11:05 +0000 +++ src/ftfont.c 2013-01-14 09:55:21 +0000 @@ -393,16 +393,14 @@ cache_data = xmalloc (sizeof *cache_data); cache_data->ft_face = NULL; cache_data->fc_charset = NULL; - val = make_save_value (NULL, 0); - XSAVE_VALUE (val)->integer = 0; - XSAVE_VALUE (val)->pointer = cache_data; + val = make_save_value (cache_data, 0); cache = Fcons (Qnil, val); Fputhash (key, cache, ft_face_cache); } else { val = XCDR (cache); - cache_data = XSAVE_VALUE (val)->pointer; + cache_data = XSAVE_POINTER (val); } if (cache_for == FTFONT_CACHE_FOR_ENTITY) @@ -468,7 +466,7 @@ cache = ftfont_lookup_cache (entity, FTFONT_CACHE_FOR_CHARSET); val = XCDR (cache); - cache_data = XSAVE_VALUE (val)->pointer; + cache_data = XSAVE_POINTER (val); return cache_data->fc_charset; } @@ -1200,9 +1198,9 @@ filename = XCAR (val); idx = XCDR (val); val = XCDR (cache); - cache_data = XSAVE_VALUE (XCDR (cache))->pointer; + cache_data = XSAVE_POINTER (XCDR (cache)); ft_face = cache_data->ft_face; - if (XSAVE_VALUE (val)->integer > 0) + if (XSAVE_INTEGER (val) > 0) { /* FT_Face in this cache is already used by the different size. */ if (FT_New_Size (ft_face, &ft_size) != 0) @@ -1213,13 +1211,13 @@ return Qnil; } } - XSAVE_VALUE (val)->integer++; + XSAVE_INTEGER (val)++; size = XINT (AREF (entity, FONT_SIZE_INDEX)); if (size == 0) size = pixel_size; if (FT_Set_Pixel_Sizes (ft_face, size, size) != 0) { - if (XSAVE_VALUE (val)->integer == 0) + if (XSAVE_INTEGER (val) == 0) FT_Done_Face (ft_face); return Qnil; } @@ -1328,10 +1326,10 @@ cache = ftfont_lookup_cache (val, FTFONT_CACHE_FOR_FACE); eassert (CONSP (cache)); val = XCDR (cache); - (XSAVE_VALUE (val)->integer)--; - if (XSAVE_VALUE (val)->integer == 0) + (XSAVE_INTEGER (val))--; + if (XSAVE_INTEGER (val) == 0) { - struct ftfont_cache_data *cache_data = XSAVE_VALUE (val)->pointer; + struct ftfont_cache_data *cache_data = XSAVE_POINTER (val); FT_Done_Face (cache_data->ft_face); #ifdef HAVE_LIBOTF === modified file 'src/gtkutil.c' --- src/gtkutil.c 2013-01-13 20:03:01 +0000 +++ src/gtkutil.c 2013-01-14 09:55:21 +0000 @@ -1650,8 +1650,7 @@ static Lisp_Object pop_down_dialog (Lisp_Object arg) { - struct Lisp_Save_Value *p = XSAVE_VALUE (arg); - struct xg_dialog_data *dd = (struct xg_dialog_data *) p->pointer; + struct xg_dialog_data *dd = (struct xg_dialog_data *) XSAVE_POINTER (arg); block_input (); if (dd->w) gtk_widget_destroy (dd->w); === modified file 'src/keymap.c' --- src/keymap.c 2013-01-01 09:11:05 +0000 +++ src/keymap.c 2013-01-14 09:55:21 +0000 @@ -566,14 +566,14 @@ if (!NILP (val)) { map_keymap_function_t fun - = (map_keymap_function_t) XSAVE_VALUE (XCAR (args))->pointer; + = (map_keymap_function_t) XSAVE_POINTER (XCAR (args)); args = XCDR (args); /* If the key is a range, make a copy since map_char_table modifies it in place. */ if (CONSP (key)) key = Fcons (XCAR (key), XCDR (key)); map_keymap_item (fun, XCDR (args), key, val, - XSAVE_VALUE (XCAR (args))->pointer); + XSAVE_POINTER (XCAR (args))); } } === modified file 'src/lisp.h' --- src/lisp.h 2013-01-12 05:21:06 +0000 +++ src/lisp.h 2013-01-14 09:55:21 +0000 @@ -1378,20 +1378,48 @@ Lisp_Object plist; }; -/* Hold a C pointer for later use. - This type of object is used in the arg to record_unwind_protect. */ +/* Types of data which may be saved in a Lisp_Save_Value. */ + +enum + { + SAVE_UNUSED, + SAVE_INTEGER, + SAVE_POINTER, + SAVE_OBJECT + }; + +/* Special object used to hold a different values for later use. */ + struct Lisp_Save_Value { ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Save_Value */ unsigned gcmarkbit : 1; - int spacer : 14; - /* If DOGC is set, POINTER is the address of a memory - area containing INTEGER potential Lisp_Objects. */ - unsigned int dogc : 1; - void *pointer; - ptrdiff_t integer; + 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; + union { + void *pointer; + ptrdiff_t integer; + Lisp_Object object; + } data[4]; }; +/* Compatibility macro to set and extract saved pointer. */ + +#define XSAVE_POINTER(obj) XSAVE_VALUE (obj)->data[0].pointer + +/* Likewise for the saved ingeger. */ + +#define XSAVE_INTEGER(obj) XSAVE_VALUE (obj)->data[1].integer /* A miscellaneous object, when it's on the free list. */ struct Lisp_Free @@ -2893,6 +2921,8 @@ /* Defined in alloc.c. */ extern void check_pure_size (void); +extern Lisp_Object allocate_misc (enum Lisp_Misc_Type); +extern void free_misc (Lisp_Object); extern void allocate_string_data (struct Lisp_String *, EMACS_INT, EMACS_INT); extern void malloc_warning (const char *); extern _Noreturn void memory_full (size_t); @@ -3695,7 +3725,7 @@ Lisp_Object arg_; \ buf = xmalloc ((nelt) * word_size); \ arg_ = make_save_value (buf, nelt); \ - XSAVE_VALUE (arg_)->dogc = 1; \ + XSAVE_VALUE (arg_)->area = 1; \ sa_must_free = 1; \ record_unwind_protect (safe_alloca_unwind, arg_); \ } \ === modified file 'src/lread.c' --- src/lread.c 2013-01-02 16:13:04 +0000 +++ src/lread.c 2013-01-14 09:55:21 +0000 @@ -1357,7 +1357,7 @@ static Lisp_Object load_unwind (Lisp_Object arg) /* Used as unwind-protect function in load. */ { - FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer; + FILE *stream = (FILE *) XSAVE_POINTER (arg); if (stream != NULL) { block_input (); === modified file 'src/nsmenu.m' --- src/nsmenu.m 2013-01-01 09:11:05 +0000 +++ src/nsmenu.m 2013-01-14 09:55:21 +0000 @@ -1347,8 +1347,7 @@ static Lisp_Object pop_down_menu (Lisp_Object arg) { - struct Lisp_Save_Value *p = XSAVE_VALUE (arg); - struct Popdown_data *unwind_data = (struct Popdown_data *) p->pointer; + struct Popdown_data *unwind_data = (struct Popdown_data *) XSAVE_POINTER (arg); block_input (); if (popup_activated_flag) === modified file 'src/nsterm.h' --- src/nsterm.h 2013-01-02 16:13:04 +0000 +++ src/nsterm.h 2013-01-14 09:55:21 +0000 @@ -675,9 +675,9 @@ #define FRAME_FONT(f) ((f)->output_data.ns->font) #ifdef __OBJC__ -#define XNS_SCROLL_BAR(vec) ((id) XSAVE_VALUE (vec)->pointer) +#define XNS_SCROLL_BAR(vec) ((id) XSAVE_POINTER (vec)) #else -#define XNS_SCROLL_BAR(vec) XSAVE_VALUE (vec)->pointer +#define XNS_SCROLL_BAR(vec) XSAVE_POINTER (vec) #endif /* Compute pixel size for vertical scroll bars */ === modified file 'src/print.c' --- src/print.c 2013-01-02 16:13:04 +0000 +++ src/print.c 2013-01-14 09:55:21 +0000 @@ -2027,8 +2027,9 @@ PRINTCHAR ('>'); break; - /* Remaining cases shouldn't happen in normal usage, but let's print - them anyway for the benefit of the debugger. */ + /* Remaining cases shouldn't happen in normal usage, but let's + print them anyway for the benefit of the debugger. */ + case Lisp_Misc_Free: strout ("#", -1, -1, printcharfun); break; @@ -2039,20 +2040,28 @@ struct Lisp_Save_Value *v = XSAVE_VALUE (obj); strout ("#dogc) + + if (v->area) { - int lim = min (v->integer, 8); - - /* 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 such a saved values are quite rare. */ - - i = sprintf (buf, "with %"pD"d objects", v->integer); + 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. */ + + int limit = min (amount, 8); + Lisp_Object *area = (Lisp_Object *) v->data[0].pointer; + + i = sprintf (buf, "with %"pD"d objects", amount); strout (buf, i, i, printcharfun); - for (i = 0; i < lim; i++) + for (i = 0; i < limit; i++) { - Lisp_Object maybe = ((Lisp_Object *) v->pointer)[i]; + Lisp_Object maybe = area[i]; if (valid_lisp_object_p (maybe) > 0) { @@ -2062,13 +2071,49 @@ else strout (" ", -1, -1, printcharfun); } - if (i == lim && i < v->integer) + if (i == limit && i < amount) strout (" ...", 4, 4, printcharfun); + +#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. */ + + i = sprintf (buf, "with %"pD"d objects", amount); + strout (buf, i, i, printcharfun); + +#endif /* GC_MARK_STACK */ } else { - i = sprintf (buf, "ptr=%p int=%"pD"d", v->pointer, v->integer); - strout (buf, i, i, printcharfun); + /* 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 + } PRINTCHAR ('>'); } === modified file 'src/xfns.c' --- src/xfns.c 2013-01-02 16:13:04 +0000 +++ src/xfns.c 2013-01-14 09:55:21 +0000 @@ -5292,8 +5292,7 @@ static Lisp_Object clean_up_file_dialog (Lisp_Object arg) { - struct Lisp_Save_Value *p = XSAVE_VALUE (arg); - Widget dialog = (Widget) p->pointer; + Widget dialog = (Widget) XSAVE_POINTER (arg); /* Clean up. */ block_input (); === modified file 'src/xmenu.c' --- src/xmenu.c 2013-01-02 16:13:04 +0000 +++ src/xmenu.c 2013-01-14 09:55:21 +0000 @@ -1411,11 +1411,9 @@ static Lisp_Object pop_down_menu (Lisp_Object arg) { - struct Lisp_Save_Value *p = XSAVE_VALUE (arg); - popup_activated_flag = 0; block_input (); - gtk_widget_destroy (GTK_WIDGET (p->pointer)); + gtk_widget_destroy (GTK_WIDGET (XSAVE_POINTER (arg))); unblock_input (); return Qnil; } @@ -1612,11 +1610,7 @@ static Lisp_Object cleanup_widget_value_tree (Lisp_Object arg) { - struct Lisp_Save_Value *p = XSAVE_VALUE (arg); - widget_value *wv = p->pointer; - - free_menubar_widget_value_tree (wv); - + free_menubar_widget_value_tree ((widget_value *) XSAVE_POINTER (arg)); return Qnil; } @@ -2242,11 +2236,8 @@ static Lisp_Object pop_down_menu (Lisp_Object arg) { - struct Lisp_Save_Value *p1 = XSAVE_VALUE (Fcar (arg)); - struct Lisp_Save_Value *p2 = XSAVE_VALUE (Fcdr (arg)); - - FRAME_PTR f = p1->pointer; - XMenu *menu = p2->pointer; + FRAME_PTR f = XSAVE_POINTER (Fcar (arg)); + XMenu *menu = XSAVE_POINTER (Fcdr (arg)); block_input (); #ifndef MSDOS === modified file 'src/xselect.c' --- src/xselect.c 2013-01-02 16:13:04 +0000 +++ src/xselect.c 2013-01-14 09:55:21 +0000 @@ -1120,7 +1120,7 @@ static Lisp_Object wait_for_property_change_unwind (Lisp_Object loc) { - struct prop_location *location = XSAVE_VALUE (loc)->pointer; + struct prop_location *location = XSAVE_POINTER (loc); unexpect_property_change (location); if (location == property_change_reply_object) ------------------------------------------------------------ revno: 111517 committer: Glenn Morris branch nick: trunk timestamp: Sun 2013-01-13 17:09:38 -0800 message: Remove compilation-error-regexp-alist-alist (presumed) extraneous backslash diff: === modified file 'lisp/progmodes/compile.el' --- lisp/progmodes/compile.el 2013-01-14 01:08:13 +0000 +++ lisp/progmodes/compile.el 2013-01-14 01:09:38 +0000 @@ -266,7 +266,7 @@ \\|[.:]\\(?3:[0-9]+\\)\\(?:-\\(?:\\(?4:[0-9]+\\)\\.\\)?\\(?5:[0-9]+\\)\\)?\\)?:\ \\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\ *\\([Ii]nfo\\(?:\\>\\|rmationa?l?\\)\\|I:\\|instantiated from\\|[Nn]ote\\)\\|\ - *[Ee]rror\\|\[0-9]?\\(?:[^0-9\n]\\|$\\)\\|[0-9][0-9][0-9]\\)" + *[Ee]rror\\|[0-9]?\\(?:[^0-9\n]\\|$\\)\\|[0-9][0-9][0-9]\\)" 1 (2 . 4) (3 . 5) (6 . 7)) (lcc