Now on revision 110881. ------------------------------------------------------------ revno: 110881 committer: Dmitry Antipov branch nick: trunk timestamp: Tue 2012-11-13 10:11:40 +0400 message: Omit glyphs initialization at startup. * dispnew.c (glyphs_initialized_initially_p): Remove. (adjust_frame_glyphs_initially): Likewise. Adjust users. (Fredraw_frame): Move actual code from here... (redraw_here): ...to here. Add eassert. Adjust comment. (Fredraw_display): Use redraw_frame. * xdisp.c (clear_garbaged_frames): Likewise. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-11-13 02:25:59 +0000 +++ src/ChangeLog 2012-11-13 06:11:40 +0000 @@ -1,3 +1,13 @@ +2012-11-13 Dmitry Antipov + + Omit glyphs initialization at startup. + * dispnew.c (glyphs_initialized_initially_p): Remove. + (adjust_frame_glyphs_initially): Likewise. Adjust users. + (Fredraw_frame): Move actual code from here... + (redraw_here): ...to here. Add eassert. Adjust comment. + (Fredraw_display): Use redraw_frame. + * xdisp.c (clear_garbaged_frames): Likewise. + 2012-11-13 Eli Zaretskii * xdisp.c (decode_mode_spec): Limit the value of WIDTH argument === modified file 'src/dispnew.c' --- src/dispnew.c 2012-11-06 13:26:20 +0000 +++ src/dispnew.c 2012-11-13 06:11:40 +0000 @@ -141,10 +141,6 @@ static bool delayed_size_change; -/* 1 means glyph initialization has been completed at startup. */ - -static bool glyphs_initialized_initially_p; - /* Updated window if != 0. Set by update_window. */ struct window *updated_window; @@ -1850,43 +1846,6 @@ unblock_input (); } - -/* Adjust frame glyphs when Emacs is initialized. - - To be called from init_display. - - We need a glyph matrix because redraw will happen soon. - Unfortunately, window sizes on selected_frame are not yet set to - meaningful values. I believe we can assume that there are only two - windows on the frame---the mini-buffer and the root window. Frame - height and width seem to be correct so far. So, set the sizes of - windows to estimated values. */ - -static void -adjust_frame_glyphs_initially (void) -{ - struct frame *sf = SELECTED_FRAME (); - struct window *root = XWINDOW (sf->root_window); - struct window *mini = XWINDOW (root->next); - int frame_lines = FRAME_LINES (sf); - int frame_cols = FRAME_COLS (sf); - int top_margin = FRAME_TOP_MARGIN (sf); - - /* Do it for the root window. */ - wset_top_line (root, make_number (top_margin)); - wset_total_lines (root, make_number (frame_lines - 1 - top_margin)); - wset_total_cols (root, make_number (frame_cols)); - - /* Do it for the mini-buffer window. */ - wset_top_line (mini, make_number (frame_lines - 1)); - wset_total_lines (mini, make_number (1)); - wset_total_cols (mini, make_number (frame_cols)); - - adjust_frame_glyphs (sf); - glyphs_initialized_initially_p = 1; -} - - /* Allocate/reallocate glyph matrices of a single frame F. */ static void @@ -3071,19 +3030,13 @@ Redrawing Frames **********************************************************************/ -DEFUN ("redraw-frame", Fredraw_frame, Sredraw_frame, 0, 1, 0, - doc: /* Clear frame FRAME and output again what is supposed to appear on it. -If FRAME is omitted or nil, the selected frame is used. */) - (Lisp_Object frame) +/* Redraw frame F. */ + +void +redraw_frame (struct frame *f) { - struct frame *f = decode_live_frame (frame); - - /* Ignore redraw requests, if frame has no glyphs yet. - (Implementation note: It still has to be checked why we are - called so early here). */ - if (!glyphs_initialized_initially_p) - return Qnil; - + /* Error if F has no glyphs. */ + eassert (f->glyphs_initialized_p); update_begin (f); #ifdef MSDOS if (FRAME_MSDOS_P (f)) @@ -3100,22 +3053,17 @@ mark_window_display_accurate (FRAME_ROOT_WINDOW (f), 0); set_window_update_flags (XWINDOW (FRAME_ROOT_WINDOW (f)), 1); f->garbaged = 0; +} + +DEFUN ("redraw-frame", Fredraw_frame, Sredraw_frame, 0, 1, 0, + doc: /* Clear frame FRAME and output again what is supposed to appear on it. +If FRAME is omitted or nil, the selected frame is used. */) + (Lisp_Object frame) +{ + redraw_frame (decode_live_frame (frame)); return Qnil; } - -/* Redraw frame F. This is nothing more than a call to the Lisp - function redraw-frame. */ - -void -redraw_frame (struct frame *f) -{ - Lisp_Object frame; - XSETFRAME (frame, f); - Fredraw_frame (frame); -} - - DEFUN ("redraw-display", Fredraw_display, Sredraw_display, 0, 0, "", doc: /* Clear and redisplay all visible frames. */) (void) @@ -3124,7 +3072,7 @@ FOR_EACH_FRAME (tail, frame) if (FRAME_VISIBLE_P (XFRAME (frame))) - Fredraw_frame (frame); + redraw_frame (XFRAME (frame)); return Qnil; } @@ -6208,7 +6156,6 @@ So call tgetent. */ { char b[2044]; tgetent (b, "xterm");} #endif - adjust_frame_glyphs_initially (); return; } #endif /* HAVE_X_WINDOWS */ @@ -6218,7 +6165,6 @@ { Vinitial_window_system = Qw32; Vwindow_system_version = make_number (1); - adjust_frame_glyphs_initially (); return; } #endif /* HAVE_NTGUI */ @@ -6232,7 +6178,6 @@ { Vinitial_window_system = Qns; Vwindow_system_version = make_number (10); - adjust_frame_glyphs_initially (); return; } #endif @@ -6322,7 +6267,6 @@ fatal ("screen size %dx%d too big", width, height); } - adjust_frame_glyphs_initially (); calculate_costs (XFRAME (selected_frame)); /* Set up faces of the initial terminal frame of a dumped Emacs. */ === modified file 'src/xdisp.c' --- src/xdisp.c 2012-11-13 02:25:59 +0000 +++ src/xdisp.c 2012-11-13 06:11:40 +0000 @@ -10769,7 +10769,7 @@ { if (f->resized_p) { - Fredraw_frame (frame); + redraw_frame (f); f->force_flush_display_p = 1; } clear_current_matrices (f); ------------------------------------------------------------ revno: 110880 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2012-11-12 23:05:35 -0500 message: * lisp/emacs-lisp/advice.el: Remove support for freezing. (ad-make-freeze-docstring, ad-make-freeze-definition): Remove functions. (ad-make-single-advice-docstring, ad-defadvice-flags, defadvice): Remove support for `freeze'. diff: === modified file 'etc/NEWS' --- etc/NEWS 2012-11-13 03:19:34 +0000 +++ etc/NEWS 2012-11-13 04:05:35 +0000 @@ -43,6 +43,8 @@ * Incompatible Lisp Changes in Emacs 24.4 +** `defadvice' does not honor the `freeze' flag any more. + ** `dolist' in lexical-binding mode does not bind VAR in RESULT any more. VAR was bound to nil which was not tremendously useful and just lead to spurious warnings about an unused var. === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-11-13 03:07:09 +0000 +++ lisp/ChangeLog 2012-11-13 04:05:35 +0000 @@ -1,5 +1,10 @@ 2012-11-13 Stefan Monnier + * emacs-lisp/advice.el: Remove support for freezing. + (ad-make-freeze-docstring, ad-make-freeze-definition): Remove functions. + (ad-make-single-advice-docstring, ad-defadvice-flags, defadvice): + Remove support for `freeze'. + * emacs-lisp/cl.el (dolist, dotimes, declare): Use advice-add to override the default. * emacs-lisp/cl-macs.el (cl-dolist, cl-dotimes): Rewrite without using @@ -16,8 +21,8 @@ 2012-11-13 Dmitry Gutov - * progmodes/ruby-mode.el (ruby-font-lock-keywords): Never - font-lock the beginning of singleton class as heredoc. + * progmodes/ruby-mode.el (ruby-font-lock-keywords): + Never font-lock the beginning of singleton class as heredoc. 2012-11-13 Stefan Monnier === modified file 'lisp/emacs-lisp/advice.el' --- lisp/emacs-lisp/advice.el 2012-11-12 20:43:43 +0000 +++ lisp/emacs-lisp/advice.el 2012-11-13 04:05:35 +0000 @@ -2686,11 +2686,6 @@ (let ((advice-docstring (ad-docstring (ad-advice-definition advice)))) (cond ((eq style 'plain) advice-docstring) - ((eq style 'freeze) - (format "Permanent %s-advice `%s':%s%s" - class (ad-advice-name advice) - (if advice-docstring "\n" "") - (or advice-docstring ""))) (t (if advice-docstring (format "%s-advice `%s':\n%s" (capitalize (symbol-name class)) @@ -2713,7 +2708,7 @@ "Construct a documentation string for the advised FUNCTION. It concatenates the original documentation with the documentation strings of the individual pieces of advice which will be formatted -according to STYLE. STYLE can be `plain' or `freeze', everything else +according to STYLE. STYLE can be `plain', everything else will be interpreted as `default'. The order of the advice documentation strings corresponds to before/around/after and the individual ordering in any of these classes." @@ -2742,8 +2737,6 @@ (defun ad-make-plain-docstring (function) (ad-make-advised-docstring function 'plain)) -(defun ad-make-freeze-docstring (function) - (ad-make-advised-docstring function 'freeze)) ;; @@@ Accessing overriding arglists and interactive forms: ;; ======================================================== @@ -3125,83 +3118,6 @@ (fmakunbound function))))) -;; @@ Freezing: -;; ============ -;; Freezing transforms a `defadvice' into a redefining `defun/defmacro' -;; for the advised function without keeping any advice information. This -;; feature was jwz's idea: It generates a dumpable function definition -;; whose documentation can be written to the DOC file, and the generated -;; code does not need any Advice runtime support. Of course, frozen advices -;; cannot be undone. - -;; Freezing only considers the advice of the particular `defadvice', other -;; already existing advices for the same function will be ignored. To ensure -;; proper interaction when an already advised function gets redefined with -;; a frozen advice, frozen advices always use the actual original definition -;; of the function, i.e., they are always at the core of the onion. E.g., if -;; an already advised function gets redefined with a frozen advice and then -;; unadvised, the frozen advice remains as the new definition of the function. - -;; While multiple freeze advices for a single function or freeze-advising -;; of an already advised function are possible, they are better avoided, -;; because definition/compile/load ordering is relevant, and it becomes -;; incomprehensible pretty quickly. - -(defun ad-make-freeze-definition (function advice class position) - (if (not (ad-has-proper-definition function)) - (error - "ad-make-freeze-definition: `%s' is not yet defined" - function)) - (cl-letf* - ((name (ad-advice-name advice)) - ;; With a unique origname we can have multiple freeze advices - ;; for the same function, each overloading the previous one: - (unique-origname - (intern (format "%s-%s-%s" (ad-make-origname function) class name))) - (orig-definition - ;; If FUNCTION is already advised, we'll use its current origdef - ;; as the original definition of the frozen advice: - (or (ad-get-orig-definition function) - (symbol-function function))) - (old-advice-info - (if (ad-is-advised function) - (ad-copy-advice-info function))) - ;; Make sure we construct a proper docstring: - ((symbol-function 'ad-make-advised-definition-docstring) - #'ad-make-freeze-docstring) - ;; Make sure `unique-origname' is used as the origname: - ((symbol-function 'ad-make-origname) (lambda (_x) unique-origname)) - (frozen-definition - (unwind-protect - (progn - ;; No we reset all current advice information to nil and - ;; generate an advised definition that's solely determined - ;; by ADVICE and the current origdef of FUNCTION: - (ad-set-advice-info function nil) - (ad-add-advice function advice class position) - ;; The following will provide proper real docstrings as - ;; well as a definition that will make the compiler happy: - (ad-set-orig-definition function orig-definition) - (ad-make-advised-definition function)) - ;; Restore the old advice state: - (ad-set-advice-info function old-advice-info)))) - (if frozen-definition - (let* ((macro-p (ad-macro-p frozen-definition)) - (body (cdr (if macro-p - (ad-lambdafy frozen-definition) - frozen-definition)))) - `(progn - (if (not (fboundp ',unique-origname)) - (fset ',unique-origname - ;; avoid infinite recursion in case the function - ;; we want to freeze is already advised: - (or (ad-get-orig-definition ',function) - (symbol-function ',function)))) - (,(if macro-p 'defmacro 'defun) - ,function - ,@body)))))) - - ;; @@ Activation and definition handling: ;; ====================================== @@ -3468,7 +3384,7 @@ ;; Completion alist of valid `defadvice' flags (defvar ad-defadvice-flags '(("protect") ("disable") ("activate") - ("compile") ("preactivate") ("freeze"))) + ("compile") ("preactivate"))) ;;;###autoload (defmacro defadvice (function args &rest body) @@ -3487,7 +3403,7 @@ ARGLIST ::= An optional argument list to be used for the advised function instead of the argument list of the original. The first one found in before/around/after-advices will be used. -FLAG ::= `protect'|`disable'|`activate'|`compile'|`preactivate'|`freeze'. +FLAG ::= `protect'|`disable'|`activate'|`compile'|`preactivate'. All flags can be specified with unambiguous initial substrings. DOCSTRING ::= Optional documentation for this piece of advice. INTERACTIVE-FORM ::= Optional interactive form to be used for the advised @@ -3513,13 +3429,6 @@ advice state that will be used during activation if appropriate. Only use this if the `defadvice' gets actually compiled. -`freeze': Expands the `defadvice' into a redefining `defun/defmacro' according -to this particular single advice. No other advice information will be saved. -Frozen advices cannot be undone, they behave like a hard redefinition of -the advised function. `freeze' implies `activate' and `preactivate'. The -documentation of the advised function can be dumped onto the `DOC' file -during preloading. - See Info node `(elisp)Advising Functions' for comprehensive documentation. usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) [DOCSTRING] [INTERACTIVE-FORM] @@ -3569,29 +3478,24 @@ (ad-preactivate-advice function advice class position)))) ;; Now for the things to be done at evaluation time: - (if (memq 'freeze flags) - ;; jwz's idea: Freeze the advised definition into a dumpable - ;; defun/defmacro whose docs can be written to the DOC file: - (ad-make-freeze-definition function advice class position) - ;; the normal case: - `(progn - (ad-add-advice ',function ',advice ',class ',position) - ,@(if preactivation - `((ad-set-cache - ',function - ;; the function will get compiled: - ,(cond ((ad-macro-p (car preactivation)) - `(ad-macrofy - (function - ,(ad-lambdafy - (car preactivation))))) - (t `(function - ,(car preactivation)))) - ',(car (cdr preactivation))))) - ,@(if (memq 'activate flags) - `((ad-activate ',function - ,(if (memq 'compile flags) t)))) - ',function)))) + `(progn + (ad-add-advice ',function ',advice ',class ',position) + ,@(if preactivation + `((ad-set-cache + ',function + ;; the function will get compiled: + ,(cond ((ad-macro-p (car preactivation)) + `(ad-macrofy + (function + ,(ad-lambdafy + (car preactivation))))) + (t `(function + ,(car preactivation)))) + ',(car (cdr preactivation))))) + ,@(if (memq 'activate flags) + `((ad-activate ',function + ,(if (memq 'compile flags) t)))) + ',function))) ;; @@ Tools: ------------------------------------------------------------ revno: 110879 committer: Glenn Morris branch nick: trunk timestamp: Mon 2012-11-12 19:19:34 -0800 message: Move SES NEWS entry here from emacs-24 and expand it Cf emacs-24 r110857. Ref: http://lists.gnu.org/archive/html/emacs-devel/2012-11/msg00221.html diff: === modified file 'etc/NEWS' --- etc/NEWS 2012-11-13 02:25:59 +0000 +++ etc/NEWS 2012-11-13 03:19:34 +0000 @@ -25,7 +25,14 @@ * Startup Changes in Emacs 24.4 * Changes in Emacs 24.4 * Editing Changes in Emacs 24.4 + + * Changes in Specialized Modes and Packages in Emacs 24.4 + ++++ +** New function `ses-rename-cell' to give SES cells arbitrary names. + + * New Modes and Packages in Emacs 24.4 ** New nadvice.el package offering lighter-weight advice facilities. It is layered as: ------------------------------------------------------------ revno: 110878 committer: Dmitry Gutov branch nick: trunk timestamp: Tue 2012-11-13 07:07:09 +0400 message: * lisp/progmodes/ruby-mode.el (ruby-font-lock-keywords): Never font-lock the beginning of singleton class as heredoc. * test/automated/ruby-mode-tests.el (ruby-heredoc-font-lock) (ruby-singleton-class-no-heredoc-font-lock): New tests. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-11-13 03:00:09 +0000 +++ lisp/ChangeLog 2012-11-13 03:07:09 +0000 @@ -14,6 +14,11 @@ (advice-add): Use them. (advice-member-p): Correctly handle macros. +2012-11-13 Dmitry Gutov + + * progmodes/ruby-mode.el (ruby-font-lock-keywords): Never + font-lock the beginning of singleton class as heredoc. + 2012-11-13 Stefan Monnier * emacs-lisp/gv.el (gv-define-simple-setter): One more fix (bug#12871). === modified file 'lisp/progmodes/ruby-mode.el' --- lisp/progmodes/ruby-mode.el 2012-11-13 02:25:59 +0000 +++ lisp/progmodes/ruby-mode.el 2012-11-13 03:07:09 +0000 @@ -1551,7 +1551,8 @@ ruby-keyword-end-re) 2) ;; here-doc beginnings - (list ruby-here-doc-beg-re 0 'font-lock-string-face) + `(,ruby-here-doc-beg-re 0 (unless (ruby-singleton-class-p (match-beginning 0)) + 'font-lock-string-face)) ;; variables '("\\(^\\|[^_:.@$]\\|\\.\\.\\)\\b\\(nil\\|self\\|true\\|false\\)\\>" 2 font-lock-variable-name-face) === modified file 'test/ChangeLog' --- test/ChangeLog 2012-11-12 20:43:43 +0000 +++ test/ChangeLog 2012-11-13 03:07:09 +0000 @@ -1,3 +1,8 @@ +2012-11-13 Dmitry Gutov + + * automated/ruby-mode-tests.el (ruby-heredoc-font-lock) + (ruby-singleton-class-no-heredoc-font-lock): New tests. + 2012-11-12 Stefan Monnier * automated/advice-tests.el: New tests. === modified file 'test/automated/ruby-mode-tests.el' --- test/automated/ruby-mode-tests.el 2012-11-12 01:11:06 +0000 +++ test/automated/ruby-mode-tests.el 2012-11-13 03:07:09 +0000 @@ -76,6 +76,14 @@ (ruby-assert-state "foo < branch nick: trunk timestamp: Mon 2012-11-12 22:00:09 -0500 message: * lisp/emacs-lisp/cl.el (dolist, dotimes, declare): Use advice-add to override the default. * lisp/emacs-lisp/cl-macs.el (cl-dolist, cl-dotimes): Rewrite without using cl--dotimes/dolist. * lisp/subr.el (dolist, dotimes, declare): Redefine them normally, even when `cl' is loaded. * lisp/emacs-lisp/nadvice.el (advice--normalize): New function, extracted from add-advice. (advice--strip-macro): New function. (advice--defalias-fset): Use them to handle macros. (advice-add): Use them. (advice-member-p): Correctly handle macros. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-11-13 02:25:59 +0000 +++ lisp/ChangeLog 2012-11-13 03:00:09 +0000 @@ -1,5 +1,21 @@ 2012-11-13 Stefan Monnier + * emacs-lisp/cl.el (dolist, dotimes, declare): Use advice-add to + override the default. + * emacs-lisp/cl-macs.el (cl-dolist, cl-dotimes): Rewrite without using + cl--dotimes/dolist. + * subr.el (dolist, dotimes, declare): Redefine them normally, even when + `cl' is loaded. + + * emacs-lisp/nadvice.el (advice--normalize): New function, extracted + from add-advice. + (advice--strip-macro): New function. + (advice--defalias-fset): Use them to handle macros. + (advice-add): Use them. + (advice-member-p): Correctly handle macros. + +2012-11-13 Stefan Monnier + * emacs-lisp/gv.el (gv-define-simple-setter): One more fix (bug#12871). 2012-11-13 Wolfgang Jenkner === modified file 'lisp/emacs-lisp/cl-loaddefs.el' --- lisp/emacs-lisp/cl-loaddefs.el 2012-11-11 11:22:06 +0000 +++ lisp/emacs-lisp/cl-loaddefs.el 2012-11-13 03:00:09 +0000 @@ -267,7 +267,7 @@ ;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when ;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp ;;;;;; cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*) -;;;;;; "cl-macs" "cl-macs.el" "a7228877484d2b39e1c2bee40b011734") +;;;;;; "cl-macs" "cl-macs.el" "c7ad09a74a1d2969406e7e2aaf3812fc") ;;; Generated autoloads from cl-macs.el (autoload 'cl--compiler-macro-list* "cl-macs" "\ === modified file 'lisp/emacs-lisp/cl-macs.el' --- lisp/emacs-lisp/cl-macs.el 2012-11-05 08:29:12 +0000 +++ lisp/emacs-lisp/cl-macs.el 2012-11-13 03:00:09 +0000 @@ -1547,9 +1547,9 @@ \(fn (VAR LIST [RESULT]) BODY...)" (declare (debug ((symbolp form &optional form) cl-declarations body)) (indent 1)) - `(cl-block nil - (,(if (eq 'cl-dolist (symbol-function 'dolist)) 'cl--dolist 'dolist) - ,spec ,@body))) + (let ((loop `(dolist ,spec ,@body))) + (if (advice-member-p #'cl--wrap-in-nil-block 'dolist) + loop `(cl-block nil ,loop)))) ;;;###autoload (defmacro cl-dotimes (spec &rest body) @@ -1560,9 +1560,9 @@ \(fn (VAR COUNT [RESULT]) BODY...)" (declare (debug cl-dolist) (indent 1)) - `(cl-block nil - (,(if (eq 'cl-dotimes (symbol-function 'dotimes)) 'cl--dotimes 'dotimes) - ,spec ,@body))) + (let ((loop `(dotimes ,spec ,@body))) + (if (advice-member-p #'cl--wrap-in-nil-block 'dotimes) + loop `(cl-block nil ,loop)))) ;;;###autoload (defmacro cl-do-symbols (spec &rest body) === modified file 'lisp/emacs-lisp/cl.el' --- lisp/emacs-lisp/cl.el 2012-11-07 08:56:16 +0000 +++ lisp/emacs-lisp/cl.el 2012-11-13 03:00:09 +0000 @@ -107,14 +107,6 @@ )) (defvaralias var (intern (format "cl-%s" var)))) -;; Before overwriting subr.el's `dotimes' and `dolist', let's remember -;; them under a different name, so we can use them in our implementation -;; of `dotimes' and `dolist'. -(unless (fboundp 'cl--dotimes) - (defalias 'cl--dotimes (symbol-function 'dotimes) "The non-CL `dotimes'.")) -(unless (fboundp 'cl--dolist) - (defalias 'cl--dolist (symbol-function 'dolist) "The non-CL `dolist'.")) - (dolist (fun '( (get* . cl-get) (random* . cl-random) @@ -228,7 +220,6 @@ remf psetf (define-setf-method . define-setf-expander) - declare the locally multiple-value-setq @@ -239,8 +230,6 @@ psetq do-all-symbols do-symbols - dotimes - dolist do* do loop @@ -322,6 +311,15 @@ (intern (format "cl-%s" fun))))) (defalias fun new))) +(defun cl--wrap-in-nil-block (fun &rest args) + `(cl-block nil ,(apply fun args))) +(advice-add 'dolist :around #'cl--wrap-in-nil-block) +(advice-add 'dotimes :around #'cl--wrap-in-nil-block) + +(defun cl--pass-args-to-cl-declare (&rest specs) + (macroexpand `(cl-declare ,@specs))) +(advice-add 'declare :after #'cl--pass-args-to-cl-declare) + ;;; Features provided a bit differently in Elisp. ;; First, the old lexical-let is now better served by `lexical-binding', tho === modified file 'lisp/emacs-lisp/nadvice.el' --- lisp/emacs-lisp/nadvice.el 2012-11-12 20:43:43 +0000 +++ lisp/emacs-lisp/nadvice.el 2012-11-13 03:00:09 +0000 @@ -230,23 +230,49 @@ (advice--make-1 (aref old 1) (aref old 3) first nrest props))))) +(defun advice--normalize (symbol def) + (cond + ((special-form-p def) + ;; Not worth the trouble trying to handle this, I think. + (error "add-advice failure: %S is a special form" symbol)) + ((and (symbolp def) + (eq 'macro (car-safe (ignore-errors (indirect-function def))))) + (let ((newval (cons 'macro (cdr (indirect-function def))))) + (put symbol 'advice--saved-rewrite (cons def newval)) + newval)) + ;; `f' might be a pure (hence read-only) cons! + ((and (eq 'macro (car-safe def)) + (not (ignore-errors (setcdr def (cdr def)) t))) + (cons 'macro (cdr def))) + (t def))) + +(defsubst advice--strip-macro (x) + (if (eq 'macro (car-safe x)) (cdr x) x)) + (defun advice--defalias-fset (fsetfun symbol newdef) - (let* ((olddef (if (fboundp symbol) (symbol-function symbol))) + (when (get symbol 'advice--saved-rewrite) + (put symbol 'advice--saved-rewrite nil)) + (setq newdef (advice--normalize symbol newdef)) + (let* ((olddef (advice--strip-macro + (if (fboundp symbol) (symbol-function symbol)))) (oldadv (cond - ((null (get symbol 'advice--pending)) - (or olddef - (progn - (message "Delayed advice activation failed for %s: no data" - symbol) - nil))) - ((or (not olddef) (autoloadp olddef)) - (prog1 (get symbol 'advice--pending) - (put symbol 'advice--pending nil))) + ((null (get symbol 'advice--pending)) + (or olddef + (progn + (message "Delayed advice activation failed for %s: no data" + symbol) + nil))) + ((or (not olddef) (autoloadp olddef)) + (prog1 (get symbol 'advice--pending) + (put symbol 'advice--pending nil))) (t (message "Dropping left-over advice--pending for %s" symbol) (put symbol 'advice--pending nil) olddef)))) - (funcall (or fsetfun #'fset) symbol (advice--subst-main oldadv newdef)))) + (let* ((snewdef (advice--strip-macro newdef)) + (snewadv (advice--subst-main oldadv snewdef))) + (funcall (or fsetfun #'fset) symbol + (if (eq snewdef newdef) snewadv (cons 'macro snewadv)))))) ;;;###autoload @@ -269,29 +295,18 @@ ;; simplest way is to make advice.el build one ad-Advice-foo function for ;; each advised function which is advice-added/removed whenever ad-activate ;; ad-deactivate is called. - (let ((f (and (fboundp symbol) (symbol-function symbol)))) - (cond - ((special-form-p f) - ;; Not worth the trouble trying to handle this, I think. - (error "add-advice failure: %S is a special form" symbol)) - ((and (symbolp f) - (eq 'macro (car-safe (ignore-errors (indirect-function f))))) - (let ((newval (cons 'macro (cdr (indirect-function f))))) - (put symbol 'advice--saved-rewrite (cons f newval)) - (fset symbol newval))) - ;; `f' might be a pure (hence read-only) cons! - ((and (eq 'macro (car-safe f)) (not (ignore-errors (setcdr f (cdr f)) t))) - (fset symbol (cons 'macro (cdr f)))) - )) - (let ((f (and (fboundp symbol) (symbol-function symbol)))) + (let* ((f (and (fboundp symbol) (symbol-function symbol))) + (nf (advice--normalize symbol f))) + (unless (eq f nf) ;; Most importantly, if nf == nil! + (fset symbol nf)) (add-function where (cond - ((eq (car-safe f) 'macro) (cdr f)) + ((eq (car-safe nf) 'macro) (cdr nf)) ;; If the function is not yet defined, we can't yet ;; install the advice. ;; FIXME: If it's an autoloaded command, we also ;; have a problem because we need to load the ;; command to build the interactive-form. - ((or (not f) (and (autoloadp f))) ;; (commandp f) + ((or (not nf) (and (autoloadp nf))) ;; (commandp nf) (get symbol 'advice--pending)) (t (symbol-function symbol))) function props) @@ -316,7 +331,7 @@ function) (unless (advice--p (if (eq (car-safe f) 'macro) (cdr f) (symbol-function symbol))) - ;; Not adviced any more. + ;; Not advised any more. (remove-function (get symbol 'defalias-fset-function) #'advice--defalias-fset) (if (eq (symbol-function symbol) @@ -335,13 +350,15 @@ ;; (setq def (advice--cdr def))))) ;;;###autoload -(defun advice-member-p (function symbol) - "Return non-nil if advice FUNCTION has been added to function SYMBOL. -Instead of FUNCTION being the actual function, it can also be the `name' +(defun advice-member-p (advice function-name) + "Return non-nil if ADVICE has been added to FUNCTION-NAME. +Instead of ADVICE being the actual function, it can also be the `name' of the piece of advice." - (advice--member-p function - (or (get symbol 'advice--pending) - (if (fboundp symbol) (symbol-function symbol))))) + (advice--member-p advice + (or (get function-name 'advice--pending) + (advice--strip-macro + (if (fboundp function-name) + (symbol-function function-name)))))) (provide 'nadvice) === modified file 'lisp/subr.el' --- lisp/subr.el 2012-11-12 20:43:43 +0000 +++ lisp/subr.el 2012-11-13 03:00:09 +0000 @@ -195,11 +195,6 @@ (declare (indent 1) (debug t)) (cons 'if (cons cond (cons nil body)))) -(if (null (featurep 'cl)) - (progn - ;; If we reload subr.el after having loaded CL, be careful not to - ;; overwrite CL's extended definition of `dolist', `dotimes', `declare'. - (defmacro dolist (spec &rest body) "Loop over a list. Evaluate BODY with VAR bound to each car from LIST, in turn. @@ -279,7 +274,6 @@ `defun-declarations-alist' and `macro-declarations-alist'." ;; FIXME: edebug spec should pay attention to defun-declarations-alist. nil) -)) (defmacro ignore-errors (&rest body) "Execute BODY; if an error occurs, return nil. === modified file 'test/automated/advice-tests.el' --- test/automated/advice-tests.el 2012-11-12 20:43:43 +0000 +++ test/automated/advice-tests.el 2012-11-13 03:00:09 +0000 @@ -50,6 +50,13 @@ ((ad-activate 'sm-test2) (sm-test2 6) 20) ((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)) + (macroexpand '(sm-test3 56)) (toto (call-test3 56))) + )) (ert-deftest advice-tests () ------------------------------------------------------------ revno: 110876 [merge] committer: Glenn Morris branch nick: trunk timestamp: Mon 2012-11-12 18:25:59 -0800 message: Merge from emacs-24; up to r110855 diff: === modified file 'doc/emacs/ChangeLog' --- doc/emacs/ChangeLog 2012-11-10 23:13:33 +0000 +++ doc/emacs/ChangeLog 2012-11-13 02:25:59 +0000 @@ -1,3 +1,12 @@ +2012-11-13 Chong Yidong + + * building.texi (Multithreaded Debugging): gdb-stopped-hooks is + actually named gdb-stopped-functions. + +2012-11-13 Glenn Morris + + * misc.texi (Single Shell): Mention async-shell-command-buffer. + 2012-11-10 Glenn Morris * misc.texi (Terminal emulator): Rename `term-face' to `term'. === modified file 'doc/emacs/building.texi' --- doc/emacs/building.texi 2012-10-27 05:03:52 +0000 +++ doc/emacs/building.texi 2012-11-12 19:54:37 +0000 @@ -1244,8 +1244,8 @@ @code{gdb-switch-reasons} to select the stop reasons which will cause a thread switch. -@vindex gdb-stopped-hooks - The variable @code{gdb-stopped-hooks} allows you to execute your +@vindex gdb-stopped-functions + The variable @code{gdb-stopped-functions} allows you to execute your functions whenever some thread stops. In non-stop mode, you can switch between different modes for GUD === modified file 'doc/emacs/misc.texi' --- doc/emacs/misc.texi 2012-11-10 01:40:48 +0000 +++ doc/emacs/misc.texi 2012-11-12 08:18:38 +0000 @@ -542,11 +542,19 @@ You can also type @kbd{M-&} (@code{async-shell-command}) to execute a shell command asynchronously; this is exactly like calling @kbd{M-!} with a trailing @samp{&}, except that you do not need the @samp{&}. -The output buffer for asynchronous shell commands is named +The default output buffer for asynchronous shell commands is named @samp{*Async Shell Command*}. Emacs inserts the output into this buffer as it comes in, whether or not the buffer is visible in a window. +@vindex async-shell-command-buffer + If you want to run more than one asynchronous shell command at the +same time, they could end up competing for the output buffer. The +option @code{async-shell-command-buffer} specifies what to do about +this; e.g., whether to rename the pre-existing output buffer, or to +use a different buffer for the new command. Consult the variable's +documentation for more possibilities. + @kindex M-| @findex shell-command-on-region @kbd{M-|} (@code{shell-command-on-region}) is like @kbd{M-!}, but === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2012-11-10 23:13:33 +0000 +++ doc/lispref/ChangeLog 2012-11-13 02:25:59 +0000 @@ -1,3 +1,18 @@ +2012-11-13 Glenn Morris + + * variables.texi (Adding Generalized Variables): + At least mention gv-define-expander and gv-letplace. + + * debugging.texi (Error Debugging): Mention debug-on-message. + (Using Debugger): Mention debugger-bury-or-kill. + + * control.texi (Signaling Errors): + * debugging.texi (Error Debugging): + * errors.texi (Standard Errors): Add user-error. + + * variables.texi (Adding Generalized Variables): + Use standard formatting for common lisp note about setf functions. + 2012-11-10 Martin Rudalics * elisp.texi (Top): Add Recombining Windows to menu. === modified file 'doc/lispref/control.texi' --- doc/lispref/control.texi 2012-10-31 21:00:57 +0000 +++ doc/lispref/control.texi 2012-11-11 00:37:40 +0000 @@ -824,6 +824,19 @@ @end example @end defun +@cindex user errors, signaling +@defun user-error format-string &rest args +This function behaves exactly like @code{error}, except that it uses +the error symbol @code{user-error} rather than @code{error}. As the +name suggests, this is intended to report errors on the part of the +user, rather than errors in the code itself. For example, +if you try to use the command @code{Info-history-back} (@kbd{l}) to +move back beyond the start of your Info browsing history, Emacs +signals a @code{user-error}. Such errors do not cause entry to the +debugger, even when @code{debug-on-error} is non-@code{nil}. +@xref{Error Debugging}. +@end defun + @cindex CL note---no continuable errors @quotation @b{Common Lisp note:} Emacs Lisp has nothing like the Common Lisp === modified file 'doc/lispref/debugging.texi' --- doc/lispref/debugging.texi 2012-09-21 03:03:48 +0000 +++ doc/lispref/debugging.texi 2012-11-11 01:16:25 +0000 @@ -117,12 +117,12 @@ any of the regular expressions, then that error does not enter the debugger. -The normal value of this variable lists several errors that happen -often during editing but rarely result from bugs in Lisp programs. -However, ``rarely'' is not ``never''; if your program fails with an -error that matches this list, you may try changing this list to debug -the error. The easiest way is usually to set -@code{debug-ignored-errors} to @code{nil}. +The normal value of this variable includes @code{user-error}, as well +as several errors that happen often during editing but rarely result +from bugs in Lisp programs. However, ``rarely'' is not ``never''; if +your program fails with an error that matches this list, you may try +changing this list to debug the error. The easiest way is usually to +set @code{debug-ignored-errors} to @code{nil}. @end defopt @defopt eval-expression-debug-on-error @@ -163,6 +163,14 @@ @code{inhibit-quit} is set and Emacs is not otherwise responding. @end defopt +@cindex message, finding what causes a particular message +@defvar debug-on-message +If you set @code{debug-on-message} to a regular expression, +Emacs will enter the debugger if it displays a matching message in the +echo area. For example, this can be useful when trying to find the +cause of a particular message. +@end defvar + To debug an error that happens during loading of the init file, use the option @samp{--debug-init}. This binds @code{debug-on-error} to @code{t} while loading the init file, and @@ -314,6 +322,7 @@ as the error message and associated data, if it was invoked due to an error). +@vindex debugger-bury-or-kill The backtrace buffer is read-only and uses a special major mode, Debugger mode, in which letters are defined as debugger commands. The usual Emacs editing commands are available; thus, you can switch windows @@ -322,8 +331,12 @@ the debugger is a recursive editing level (@pxref{Recursive Editing}) and it is wise to go back to the backtrace buffer and exit the debugger (with the @kbd{q} command) when you are finished with it. Exiting -the debugger gets out of the recursive edit and kills the backtrace -buffer. +the debugger gets out of the recursive edit and buries the backtrace +buffer. (You can customize what the @kbd{q} command does with the +backtrace buffer by setting the variable @code{debugger-bury-or-kill}. +For example, set it to @code{kill} if you prefer to kill the buffer +rather than bury it. Consult the variable's documentation for more +possibilities.) When the debugger has been entered, the @code{debug-on-error} variable is temporarily set according to === modified file 'doc/lispref/errors.texi' --- doc/lispref/errors.texi 2012-10-31 20:59:04 +0000 +++ doc/lispref/errors.texi 2012-11-11 00:37:40 +0000 @@ -172,6 +172,9 @@ @item undefined-color The message is @samp{Undefined color}. @xref{Color Names}. +@item user-error +The message is the empty string. @xref{Signaling Errors}. + @item void-function The message is @samp{Symbol's function definition is void}. @xref{Function Cells}. === modified file 'doc/lispref/variables.texi' --- doc/lispref/variables.texi 2012-11-07 05:22:10 +0000 +++ doc/lispref/variables.texi 2012-11-12 08:23:23 +0000 @@ -2133,20 +2133,24 @@ @end example @end defmac -@c FIXME? Not sure what, if anything, to say about this. -@ignore -@defmac gv-define-expander name handler -This is the most general way to define a new @code{setf} expansion. -@end defmac -@end ignore +@findex gv-define-expander +@findex gv-letplace +@c FIXME? Not sure what or how much to say about these. +@c See cl.texi for an example of using gv-letplace. +For more control over the expansion, see the macro @code{gv-define-expander}. +The macro @code{gv-letplace} can be useful in defining macros that +perform similarly to @code{setf}; for example, the @code{incf} macro +of Common Lisp. Consult the source file @file{gv.el} for more details. @cindex CL note---no @code{setf} functions -Common Lisp defines another way to specify the @code{setf} behavior of -a function, namely ``@code{setf} functions'', whose names are lists -@code{(setf @var{name})} rather than symbols. For example, -@code{(defun (setf foo) @dots{})} defines the function that is used -when @code{setf} is applied to @code{foo}. Emacs does not support -this. It is a compile-time error to use @code{setf} on a form that -has not already had an appropriate expansion defined. In Common Lisp, -this is not an error since the function @code{(setf @var{func})} might -be defined later. +@quotation +@b{Common Lisp note:} Common Lisp defines another way to specify the +@code{setf} behavior of a function, namely ``@code{setf} functions'', +whose names are lists @code{(setf @var{name})} rather than symbols. +For example, @code{(defun (setf foo) @dots{})} defines the function +that is used when @code{setf} is applied to @code{foo}. Emacs does +not support this. It is a compile-time error to use @code{setf} on a +form that has not already had an appropriate expansion defined. In +Common Lisp, this is not an error since the function @code{(setf +@var{func})} might be defined later. +@end quotation === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2012-11-12 05:53:53 +0000 +++ doc/misc/ChangeLog 2012-11-13 02:25:59 +0000 @@ -1,3 +1,9 @@ +2012-11-13 Glenn Morris + + * flymake.texi (Customizable variables) + (Highlighting erroneous lines): Mention flymake-error-bitmap, + flymake-warning-bitmap, and flymake-fringe-indicator-position. + 2012-11-12 Vincent Belaïche * ses.texi: Doc for ses-rename-cell, ses-repair-cell-reference-all & ses-range. === modified file 'doc/misc/flymake.texi' --- doc/misc/flymake.texi 2012-03-10 04:10:21 +0000 +++ doc/misc/flymake.texi 2012-11-12 08:42:27 +0000 @@ -337,6 +337,17 @@ A custom face for highlighting lines for which at least one warning and no errors have been reported. +@item flymake-error-bitmap +A bitmap used in the fringe to mark lines for which an error has +been reported. + +@item flymake-warning-bitmap +A bitmap used in the fringe to mark lines for which a warning has +been reported. + +@item flymake-fringe-indicator-position +Which fringe (if any) should show the warning/error bitmaps. + @end table @node Adding support for a new syntax check tool @@ -718,6 +729,15 @@ @code{flymake-warnline}. Errors belonging outside the current buffer are considered to belong to line 1 of the current buffer. +@c This manual does not use vindex. +@c @vindex flymake-fringe-indicator-position +@c @vindex flymake-error-bitmap +@c @vindex flymake-warning-bitmap +If the option @code{flymake-fringe-indicator-position} is non-@code{nil}, +errors and warnings are also highlighted in the left or right fringe, +using the bitmaps specified by @code{flymake-error-bitmap} +and @code{flymake-warning-bitmap}. + @node Interaction with other modes @section Interaction with other modes @cindex Interaction with other modes === modified file 'etc/NEWS' --- etc/NEWS 2012-11-12 20:43:43 +0000 +++ etc/NEWS 2012-11-13 02:25:59 +0000 @@ -162,6 +162,7 @@ *** minibuffer-electric-default-mode can rewrite (default ...) to [...]. Just set minibuffer-eldef-shorten-default to t before enabling the mode. ++++ ** ImageMagick support, if available, is automatically enabled. It is no longer necessary to call `imagemagick-register-types' explicitly to install ImageMagick image types; that function is called @@ -470,6 +471,7 @@ *** ERC will look up server/channel names via auth-source and use any channel keys found. ++++ ** Flymake uses fringe bitmaps to indicate errors and warnings. See `flymake-fringe-indicator-position', `flymake-error-bitmap' and `flymake-warning-bitmap'. @@ -478,10 +480,12 @@ ** Follow mode no longer works by using advice. The option `follow-intercept-processes' has been removed. +--- ** The FFAP option `ffap-url-unwrap-remote' can now be a list of strings, -specifying URL types which should be converted to remote file names at +specifying URL types that should be converted to remote file names at the FFAP prompt. The default is now '("ftp"). +--- ** New Ibuffer `derived-mode' filter, bound to `/ M'. The old binding for `/ M' (filter by used-mode) is now bound to `/ m'. @@ -497,11 +501,14 @@ The function `notifications-get-capabilities' returns the supported server properties. +--- ** In Perl mode, new option `perl-indent-parens-as-block' causes non-block closing brackets to be aligned with the line of the opening bracket. +--- ** In Proced mode, new command `proced-renice' renices marked processes. +--- ** Python mode A new version of python.el, which provides several new features, including: @@ -548,6 +555,8 @@ python-find-function | python-nav-jump-to-defun python-next-statement | python-nav-forward-sentence python-previous-statement | python-nav-backward-sentence +python-beginning-of-defun-function | python-nav-beginning-of-defun +python-end-of-defun-function | python-nav-end-of-defun python-send-buffer | python-shell-send-buffer python-send-defun | python-shell-send-defun python-send-region | python-shell-send-region @@ -586,8 +595,9 @@ *** `sh-use-smie' lets you choose a new indentation and navigation code. ++++ ** New option `async-shell-command-buffer' specifies the buffer to use -for a new asynchronous shell command when the default output buffer +for a new asynchronous `shell-command' when the default output buffer `*Async Shell Command*' is already in use. --- @@ -831,11 +841,15 @@ ** Debugger changes ++++ *** New error type and new function `user-error'. These do not trigger the debugger. -*** New option `debugger-bury-or-kill'. ++++ +*** New option `debugger-bury-or-kill', saying what to do with the +debugger buffer when exiting debug. ++++ *** Set `debug-on-message' to enter the debugger when a certain message is displayed in the echo area. This can be useful when trying to work out which code is doing something. @@ -900,7 +914,7 @@ *** `current-time-string' no longer requires that its argument's year must be in the range 1000..9999. It now works with any year supported by the underlying C implementation. - ++++ *** `current-time' now returns extended-format time stamps (HIGH LOW USEC PSEC), where the new PSEC slot specifies picoseconds. PSEC is typically a multiple of 1000 on current machines. Other @@ -912,7 +926,7 @@ [TRIGGERED-P HI-SECS LO-SECS USECS REPEAT-DELAY FUNCTION ARGS IDLE-DELAY PSECS]. The PSECS slot is new, and uses picosecond resolution. It can be accessed via the new timer--psecs accessor. - ++++ *** Last-modified time stamps in undo lists now are of the form (t HI-SECS LO-SECS USECS PSECS) instead of (t HI-SECS . LO-SECS). === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-11-12 20:43:43 +0000 +++ lisp/ChangeLog 2012-11-13 02:25:59 +0000 @@ -1,3 +1,53 @@ +2012-11-13 Stefan Monnier + + * emacs-lisp/gv.el (gv-define-simple-setter): One more fix (bug#12871). + +2012-11-13 Wolfgang Jenkner + + * ansi-color.el (ansi-color-apply-sequence): Implement SGR codes + 39 and 49 (bug#12792). Also, treat unimplemented parameters as 0, + thereby restoring the behavior of revisions prior to 109621. + +2012-11-13 Fabián Ezequiel Gallina + + Fix end-of-defun misbehavior. + * progmodes/python.el (python-nav-beginning-of-defun): Rename from + python-beginning-of-defun-function. Handle nested defuns + correctly. + (python-nav-end-of-defun): Rename from + python-end-of-defun-function. Ensure forward movement. + (python-info-current-defun): Reimplement to work as intended + with new fixed python-nav-{end,beginning}-of-defun. Stop scanning + parent defuns as soon as possible. + +2012-11-13 Glenn Morris + + * progmodes/flymake.el (flymake-error-bitmap) + (flymake-warning-bitmap, flymake-fringe-indicator-position): Doc fixes. + (flymake-error-bitmap, flymake-warning-bitmap): Fix :types. + +2012-11-13 Dmitry Gutov + + * progmodes/ruby-mode.el (ruby-move-to-block): When moving + backward, always stop at indentation. Reverts the change from + 109576 (Bug#12851). + +2012-11-13 Glenn Morris + + * ibuffer.el (ibuffer-mode-map, ibuffer-mode): + Add ibuffer-filter-by-derived-mode. + + * ibuffer.el (ibuffer-mode-map): Don't have two menu items with + the same name shadowing each other. + + * window.el (with-temp-buffer-window): Doc tweak. + + * emacs-lisp/debug.el (debugger-bury-or-kill): Doc tweak. + + * help.el (temp-buffer-max-height): + * window.el (fit-frame-to-buffer, fit-frame-to-buffer-bottom-margin): + * emacs-lisp/debug.el (debugger-bury-or-kill): Fix :version. + 2012-11-12 Stefan Monnier * emacs-lisp/nadvice.el: New package. === modified file 'lisp/ansi-color.el' --- lisp/ansi-color.el 2012-09-25 04:13:02 +0000 +++ lisp/ansi-color.el 2012-11-12 17:12:33 +0000 @@ -534,34 +534,39 @@ ESCAPE-SEQ is an escape sequence parsed by `ansi-color-parse-sequence'. -If the new codes resulting from ESCAPE-SEQ start with 0, then the -old codes are discarded and the remaining new codes are -processed. Otherwise, for each new code: if it is 21-25 or 27-29 -delete appropriate parameters from the list of codes; any other -code that makes sense is added to the list of codes. Finally, -the so changed list of codes is returned." +For each new code, the following happens: if it is 1-7, add it to +the list of codes; if it is 21-25 or 27, delete appropriate +parameters from the list of codes; if it is 30-37 resp. 39, the +foreground color code is replaced or added resp. deleted; if it +is 40-47 resp. 49, the background color code is replaced or added +resp. deleted; any other code is discarded together with the old +codes. Finally, the so changed list of codes is returned." (let ((new-codes (ansi-color-parse-sequence escape-sequence))) (while new-codes - (setq codes - (let ((new (pop new-codes))) - (cond ((zerop new) - nil) - ((or (<= new 20) - (>= new 30)) - (if (memq new codes) - codes - (cons new codes))) - ;; The standard says `21 doubly underlined' while - ;; http://en.wikipedia.org/wiki/ANSI_escape_code claims - ;; `21 Bright/Bold: off or Underline: Double'. - ((/= new 26) - (remq (- new 20) - (cond ((= new 22) - (remq 1 codes)) - ((= new 25) - (remq 6 codes)) - (t codes)))) - (t codes))))) + (let* ((new (pop new-codes)) + (q (/ new 10))) + (setq codes + (pcase q + (0 (unless (memq new '(0 8 9)) + (cons new (remq new codes)))) + (2 (unless (memq new '(20 26 28 29)) + ;; The standard says `21 doubly underlined' while + ;; http://en.wikipedia.org/wiki/ANSI_escape_code claims + ;; `21 Bright/Bold: off or Underline: Double'. + (remq (- new 20) (pcase new + (22 (remq 1 codes)) + (25 (remq 6 codes)) + (_ codes))))) + ((or 3 4) (let ((r (mod new 10))) + (unless (= r 8) + (let (beg) + (while (and codes (/= q (/ (car codes) 10))) + (push (pop codes) beg)) + (setq codes (nconc (nreverse beg) (cdr codes))) + (if (= r 9) + codes + (cons new codes)))))) + (_ nil))))) codes)) (defun ansi-color-make-color-map () === modified file 'lisp/cedet/ChangeLog' --- lisp/cedet/ChangeLog 2012-10-25 20:13:16 +0000 +++ lisp/cedet/ChangeLog 2012-11-13 02:25:59 +0000 @@ -1,7 +1,20 @@ +2012-11-13 Stefan Monnier + + * semantic/mru-bookmark.el (semantic-mru-bookmark-mode): + * semantic/grammar.el (semantic-grammar-mode): + * semantic/util-modes.el (semantic-highlight-edits-mode) + (semantic-show-parser-state-mode): Avoid obsolete name + semantic-edits-new-change-hooks (bug#12869). + +2012-11-13 Glenn Morris + + * srecode/srt-mode.el (srecode-template-mode): + Don't change global values of comment-start, comment-end. (Bug#12781) + 2012-10-25 David Engster - * semantic/analyze.el (semantic-analyze-dereference-alias): New - function to dereference aliases. + * semantic/analyze.el (semantic-analyze-dereference-alias): + New function to dereference aliases. (semantic-analyze-current-context-default): Use it. * semantic/grammar.el (semantic-grammar-create-package): @@ -12,8 +25,8 @@ * semantic.el (semantic-elapsed-time): Make it a defsubst. - * srecode/dictionary.el (srecode-adebug-dictionary): Remove - require for `semantic'. + * srecode/dictionary.el (srecode-adebug-dictionary): + Remove require for `semantic'. * srecode/map.el: * srecode/insert.el: Declare functions from `data-debug'. === modified file 'lisp/cedet/semantic/grammar.el' --- lisp/cedet/semantic/grammar.el 2012-10-25 20:13:16 +0000 +++ lisp/cedet/semantic/grammar.el 2012-11-12 16:50:08 +0000 @@ -1333,8 +1333,8 @@ (add-hook 'before-change-functions 'semantic--grammar-clear-macros-regexp-2 nil t) ;; Handle safe re-parse of grammar rules. - (semantic-make-local-hook 'semantic-edits-new-change-hooks) - (add-hook 'semantic-edits-new-change-hooks + (semantic-make-local-hook 'semantic-edits-new-change-functions) + (add-hook 'semantic-edits-new-change-functions 'semantic-grammar-edits-new-change-hook-fcn nil t) (semantic-run-mode-hooks 'semantic-grammar-mode-hook)) === modified file 'lisp/cedet/semantic/mru-bookmark.el' --- lisp/cedet/semantic/mru-bookmark.el 2012-10-01 18:10:29 +0000 +++ lisp/cedet/semantic/mru-bookmark.el 2012-11-12 16:50:08 +0000 @@ -292,13 +292,13 @@ (setq semantic-mru-bookmark-mode nil) (error "Buffer %s was not set up for parsing" (buffer-name))) - (semantic-make-local-hook 'semantic-edits-new-change-hooks) - (add-hook 'semantic-edits-new-change-hooks + (semantic-make-local-hook 'semantic-edits-new-change-functions) + (add-hook 'semantic-edits-new-change-functions 'semantic-mru-bookmark-change-hook-fcn nil t) (add-hook 'semantic-edits-move-change-hooks 'semantic-mru-bookmark-change-hook-fcn nil t)) ;; Remove hooks - (remove-hook 'semantic-edits-new-change-hooks + (remove-hook 'semantic-edits-new-change-functions 'semantic-mru-bookmark-change-hook-fcn t) (remove-hook 'semantic-edits-move-change-hooks 'semantic-mru-bookmark-change-hook-fcn t))) === modified file 'lisp/cedet/semantic/util-modes.el' --- lisp/cedet/semantic/util-modes.el 2012-01-19 07:21:25 +0000 +++ lisp/cedet/semantic/util-modes.el 2012-11-12 16:50:08 +0000 @@ -221,11 +221,11 @@ (setq semantic-highlight-edits-mode nil) (error "Buffer %s was not set up for parsing" (buffer-name))) - (semantic-make-local-hook 'semantic-edits-new-change-hooks) - (add-hook 'semantic-edits-new-change-hooks + (semantic-make-local-hook 'semantic-edits-new-change-functions) + (add-hook 'semantic-edits-new-change-functions 'semantic-highlight-edits-new-change-hook-fcn nil t)) ;; Remove hooks - (remove-hook 'semantic-edits-new-change-hooks + (remove-hook 'semantic-edits-new-change-functions 'semantic-highlight-edits-new-change-hook-fcn t))) (semantic-add-minor-mode 'semantic-highlight-edits-mode @@ -460,8 +460,8 @@ (append mode-line-modified '(semantic-show-parser-state-string)))) ;; Add hooks - (semantic-make-local-hook 'semantic-edits-new-change-hooks) - (add-hook 'semantic-edits-new-change-hooks + (semantic-make-local-hook 'semantic-edits-new-change-functions) + (add-hook 'semantic-edits-new-change-functions 'semantic-show-parser-state-marker nil t) (semantic-make-local-hook 'semantic-edits-incremental-reparse-failed-hook) (add-hook 'semantic-edits-incremental-reparse-failed-hook @@ -491,7 +491,7 @@ (setq mode-line-modified (delq 'semantic-show-parser-state-string mode-line-modified)) ;; Remove hooks - (remove-hook 'semantic-edits-new-change-hooks + (remove-hook 'semantic-edits-new-change-functions 'semantic-show-parser-state-marker t) (remove-hook 'semantic-edits-incremental-reparse-failed-hook 'semantic-show-parser-state-marker t) === modified file 'lisp/cedet/srecode/srt-mode.el' --- lisp/cedet/srecode/srt-mode.el 2012-10-01 18:10:29 +0000 +++ lisp/cedet/srecode/srt-mode.el 2012-11-10 23:43:47 +0000 @@ -189,8 +189,8 @@ ;;;###autoload (define-derived-mode srecode-template-mode fundamental-mode "SRecorder" "Major-mode for writing SRecode macros." - (setq comment-start ";;" - comment-end "") + (set (make-local-variable 'comment-start) ";;") + (set (make-local-variable 'comment-end) "") (set (make-local-variable 'parse-sexp-ignore-comments) t) (set (make-local-variable 'comment-start-skip) "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *") === modified file 'lisp/emacs-lisp/debug.el' --- lisp/emacs-lisp/debug.el 2012-11-12 20:43:43 +0000 +++ lisp/emacs-lisp/debug.el 2012-11-13 02:25:59 +0000 @@ -49,9 +49,9 @@ :version "21.1") (defcustom debugger-bury-or-kill 'bury - "How to proceed with the debugger buffer when exiting `debug'. -The value used here affects the behavior of operations on any -window previously showing the debugger buffer. + "What to do with the debugger buffer when exiting `debug'. +The value affects the behavior of operations on any window +previously showing the debugger buffer. `nil' means that if its window is not deleted when exiting the debugger, invoking `switch-to-prev-buffer' will usually show @@ -79,7 +79,7 @@ (const :tag "Bury" bury) (const :tag "Kill" kill)) :group 'debugger - :version "24.2") + :version "24.3") (defvar debugger-step-after-exit nil "Non-nil means \"single-step\" after the debugger exits.") === modified file 'lisp/emacs-lisp/gv.el' --- lisp/emacs-lisp/gv.el 2012-11-10 23:13:33 +0000 +++ lisp/emacs-lisp/gv.el 2012-11-13 02:25:59 +0000 @@ -220,8 +220,9 @@ `(gv-define-setter ,name (val &rest args) ,(if fix-return `(macroexp-let2 nil v val - (cons ',setter (append args (list v))) - v) + `(progn + (,',setter ,@(append args (list v))) + ,v)) `(cons ',setter (append args (list val)))))) ;;; Typical operations on generalized variables. === modified file 'lisp/help.el' --- lisp/help.el 2012-10-26 09:11:24 +0000 +++ lisp/help.el 2012-11-11 00:43:54 +0000 @@ -979,7 +979,7 @@ function is called, the window to be resized is selected." :type '(choice integer function) :group 'help - :version "24.2") + :version "24.3") (define-minor-mode temp-buffer-resize-mode "Toggle auto-resizing temporary buffer windows (Temp Buffer Resize Mode). === modified file 'lisp/ibuffer.el' --- lisp/ibuffer.el 2012-09-24 10:20:50 +0000 +++ lisp/ibuffer.el 2012-11-11 02:22:26 +0000 @@ -632,10 +632,13 @@ '(menu-item "Disable all filtering" ibuffer-filter-disable :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers))) (define-key-after map [menu-bar view filter filter-by-mode] - '(menu-item "Add filter by major mode..." ibuffer-filter-by-mode)) - (define-key-after map [menu-bar view filter filter-by-mode] - '(menu-item "Add filter by major mode in use..." + '(menu-item "Add filter by any major mode..." ibuffer-filter-by-mode)) + (define-key-after map [menu-bar view filter filter-by-used-mode] + '(menu-item "Add filter by a major mode in use..." ibuffer-filter-by-used-mode)) + (define-key-after map [menu-bar view filter filter-by-derived-mode] + '(menu-item "Add filter by derived mode..." + ibuffer-filter-by-derived-mode)) (define-key-after map [menu-bar view filter filter-by-name] '(menu-item "Add filter by buffer name..." ibuffer-filter-by-name)) (define-key-after map [menu-bar view filter filter-by-filename] @@ -2438,8 +2441,9 @@ Filtering commands: - '\\[ibuffer-filter-by-mode]' - Add a filter by major mode. - '\\[ibuffer-filter-by-used-mode]' - Add a filter by major mode now in use. + '\\[ibuffer-filter-by-mode]' - Add a filter by any major mode. + '\\[ibuffer-filter-by-used-mode]' - Add a filter by a major mode now in use. + '\\[ibuffer-filter-by-derived-mode]' - Add a filter by derived mode. '\\[ibuffer-filter-by-name]' - Add a filter by buffer name. '\\[ibuffer-filter-by-content]' - Add a filter by buffer content. '\\[ibuffer-filter-by-filename]' - Add a filter by filename. === modified file 'lisp/progmodes/flymake.el' --- lisp/progmodes/flymake.el 2012-10-20 11:34:06 +0000 +++ lisp/progmodes/flymake.el 2012-11-12 08:42:27 +0000 @@ -764,25 +764,39 @@ (and (overlayp ov) (overlay-get ov 'flymake-overlay))) (defcustom flymake-error-bitmap '(exclamation-mark error) - "Bitmap used in the fringe for indicating errors. + "Bitmap (a symbol) used in the fringe for indicating errors. The value may also be a list of two elements where the second -element specifies the face for the bitmap." +element specifies the face for the bitmap. For possible bitmap +symbols, see `fringe-bitmaps'. See also `flymake-warning-bitmap'. + +The option `flymake-fringe-indicator-position' controls how and where +this is used." :group 'flymake :version "24.3" - :type 'symbol) + :type '(choice (symbol :tag "Bitmap") + (list :tag "Bitmap and face" + (symbol :tag "Bitmap") + (face :tag "Face")))) (defcustom flymake-warning-bitmap 'question-mark - "Bitmap used in the fringe for indicating warnings. + "Bitmap (a symbol) used in the fringe for indicating warnings. The value may also be a list of two elements where the second -element specifies the face for the bitmap." +element specifies the face for the bitmap. For possible bitmap +symbols, see `fringe-bitmaps'. See also `flymake-error-bitmap'. + +The option `flymake-fringe-indicator-position' controls how and where +this is used." :group 'flymake :version "24.3" - :type 'symbol) + :type '(choice (symbol :tag "Bitmap") + (list :tag "Bitmap and face" + (symbol :tag "Bitmap") + (face :tag "Face")))) (defcustom flymake-fringe-indicator-position 'left-fringe "The position to put flymake fringe indicator. -The value can be nil, left-fringe or right-fringe. -Fringe indicators are disabled if nil." +The value can be nil (do not use indicators), `left-fringe' or `right-fringe'. +See `flymake-error-bitmap' and `flymake-warning-bitmap'." :group 'flymake :version "24.3" :type '(choice (const left-fringe) === modified file 'lisp/progmodes/python.el' --- lisp/progmodes/python.el 2012-11-03 12:20:02 +0000 +++ lisp/progmodes/python.el 2012-11-12 13:26:50 +0000 @@ -1074,12 +1074,9 @@ The name of the defun should be grouped so it can be retrieved via `match-string'.") -(defun python-nav-beginning-of-defun (&optional arg) - "Move point to `beginning-of-defun'. -With positive ARG move search backwards. With negative do the -same but forward. When ARG is nil or 0 defaults to 1. This is -the main part of `python-beginning-of-defun-function'. Return -non-nil if point is moved to `beginning-of-defun'." +(defun python-nav--beginning-of-defun (&optional arg) + "Internal implementation of `python-nav-beginning-of-defun'. +With positive ARG search backwards, else search forwards." (when (or (null arg) (= arg 0)) (setq arg 1)) (let* ((re-search-fn (if (> arg 0) #'re-search-backward @@ -1087,6 +1084,15 @@ (line-beg-pos (line-beginning-position)) (line-content-start (+ line-beg-pos (current-indentation))) (pos (point-marker)) + (beg-indentation + (and (> arg 0) + (save-excursion + (and (python-info-current-line-empty-p) + (python-util-forward-comment -1)) + (python-nav-beginning-of-statement) + (if (python-info-looking-at-beginning-of-defun) + (+ (current-indentation) python-indent-offset) + (current-indentation))))) (found (progn (when (and (< arg 0) @@ -1094,7 +1100,12 @@ (end-of-line 1)) (while (and (funcall re-search-fn python-nav-beginning-of-defun-regexp nil t) - (python-syntax-context-type))) + (or (python-syntax-context-type) + ;; Handle nested defuns when moving + ;; backwards by checking indentation. + (and (> arg 0) + (not (= (current-indentation) 0)) + (>= (current-indentation) beg-indentation))))) (and (python-info-looking-at-beginning-of-defun) (or (not (= (line-number-at-pos pos) (line-number-at-pos))) @@ -1105,55 +1116,43 @@ (or (beginning-of-line 1) t) (and (goto-char pos) nil)))) -(defun python-beginning-of-defun-function (&optional arg) - "Move point to the beginning of def or class. -With positive ARG move that number of functions backwards. With -negative do the same but forward. When ARG is nil or 0 defaults -to 1. Return non-nil if point is moved to `beginning-of-defun'." +(defun python-nav-beginning-of-defun (&optional arg) + "Move point to `beginning-of-defun'. +With positive ARG search backwards else search forward. When ARG +is nil or 0 defaults to 1. When searching backwards nested +defuns are handled with care depending on current point +position. Return non-nil if point is moved to +`beginning-of-defun'." (when (or (null arg) (= arg 0)) (setq arg 1)) (let ((found)) (cond ((and (eq this-command 'mark-defun) (python-info-looking-at-beginning-of-defun))) (t (dotimes (i (if (> arg 0) arg (- arg))) - (when (and (python-nav-beginning-of-defun arg) + (when (and (python-nav--beginning-of-defun arg) (not found)) (setq found t))))) found)) -(defun python-end-of-defun-function () +(defun python-nav-end-of-defun () "Move point to the end of def or class. Returns nil if point is not in a def or class." (interactive) - (let ((beg-defun-indent)) + (let ((beg-defun-indent) + (beg-pos (point))) (when (or (python-info-looking-at-beginning-of-defun) - (python-beginning-of-defun-function 1) - (python-beginning-of-defun-function -1)) + (python-nav-beginning-of-defun 1) + (python-nav-beginning-of-defun -1)) (setq beg-defun-indent (current-indentation)) - (forward-line 1) - ;; Go as forward as possible - (while (and (or - (python-nav-beginning-of-defun -1) - (and (goto-char (point-max)) nil)) - (> (current-indentation) beg-defun-indent))) - (beginning-of-line 1) - ;; Go as backwards as possible - (while (and (forward-line -1) - (not (bobp)) - (or (not (current-word)) - (equal (char-after (+ (point) (current-indentation))) ?#) - (<= (current-indentation) beg-defun-indent) - (looking-at (python-rx decorator)) - (python-syntax-context-type)))) - (forward-line 1) - ;; If point falls inside a paren or string context the point is - ;; forwarded at the end of it (or end of buffer if its not closed) - (let ((context-type (python-syntax-context-type))) - (when (memq context-type '(paren string)) - ;; Slow but safe. - (while (and (not (eobp)) - (python-syntax-context-type)) - (forward-line 1))))))) + (while (progn + (python-nav-end-of-statement) + (python-util-forward-comment 1) + (and (> (current-indentation) beg-defun-indent) + (not (eobp))))) + (python-util-forward-comment -1) + (forward-line 1) + ;; Ensure point moves forward. + (and (> beg-pos (point)) (goto-char beg-pos))))) (defun python-nav-beginning-of-statement () "Move to start of current statement." @@ -2022,7 +2021,7 @@ (python-shell-send-region (progn (end-of-line 1) - (while (and (or (python-beginning-of-defun-function) + (while (and (or (python-nav-beginning-of-defun) (beginning-of-line 1)) (> (current-indentation) 0))) (when (not arg) @@ -2031,7 +2030,7 @@ (forward-line 1)) (point-marker)) (progn - (or (python-end-of-defun-function) + (or (python-nav-end-of-defun) (end-of-line 1)) (point-marker))))) @@ -2879,38 +2878,40 @@ This function is compatible to be used as `add-log-current-defun-function' since it returns nil if point is not inside a defun." - (let ((names '()) - (starting-indentation) - (starting-point) - (first-run t)) (save-restriction (widen) (save-excursion - (setq starting-point (point-marker)) - (setq starting-indentation (save-excursion - (python-nav-beginning-of-statement) - (current-indentation))) (end-of-line 1) - (while (python-beginning-of-defun-function 1) - (when (or (< (current-indentation) starting-indentation) - (and first-run - (< - starting-point - (save-excursion - (python-end-of-defun-function) - (point-marker))))) - (setq first-run nil) - (setq starting-indentation (current-indentation)) - (looking-at python-nav-beginning-of-defun-regexp) - (setq names (cons + (let ((names) + (starting-indentation + (save-excursion + (and + (python-nav-beginning-of-defun 1) + ;; This extra number is just for checking code + ;; against indentation to work well on first run. + (+ (current-indentation) 4)))) + (starting-point (point))) + ;; Check point is inside a defun. + (when (and starting-indentation + (< starting-point + (save-excursion + (python-nav-end-of-defun) + (point)))) + (catch 'exit + (while (python-nav-beginning-of-defun 1) + (when (< (current-indentation) starting-indentation) + (setq starting-indentation (current-indentation)) + (setq names + (cons (if (not include-type) (match-string-no-properties 1) (mapconcat 'identity (split-string (match-string-no-properties 0)) " ")) - names)))))) - (when names - (mapconcat (lambda (string) string) names ".")))) + names))) + (and (= (current-indentation) 0) (throw 'exit t))))) + (and names + (mapconcat (lambda (string) string) names ".")))))) (defun python-info-current-symbol (&optional replace-self) "Return current symbol using dotty syntax. @@ -3200,9 +3201,9 @@ 'python-fill-paragraph) (set (make-local-variable 'beginning-of-defun-function) - #'python-beginning-of-defun-function) + #'python-nav-beginning-of-defun) (set (make-local-variable 'end-of-defun-function) - #'python-end-of-defun-function) + #'python-nav-end-of-defun) (add-hook 'completion-at-point-functions 'python-completion-complete-at-point nil 'local) @@ -3230,7 +3231,7 @@ (add-to-list 'hs-special-modes-alist `(python-mode "^\\s-*\\(?:def\\|class\\)\\>" nil "#" ,(lambda (arg) - (python-end-of-defun-function)) nil)) + (python-nav-end-of-defun)) nil)) (set (make-local-variable 'mode-require-final-newline) t) === modified file 'lisp/progmodes/ruby-mode.el' --- lisp/progmodes/ruby-mode.el 2012-11-08 16:37:34 +0000 +++ lisp/progmodes/ruby-mode.el 2012-11-13 02:25:59 +0000 @@ -898,17 +898,7 @@ (back-to-indentation) (if (looking-at (concat "\\<\\(" ruby-block-mid-re "\\)\\>")) (setq done nil))))) - (back-to-indentation) - (when (< n 0) - (let ((eol (point-at-eol)) state next) - (if (< orig eol) (setq eol orig)) - (setq orig (point)) - (while (and (setq next (apply 'ruby-parse-partial eol state)) - (< (point) eol)) - (setq state next)) - (when (cdaadr state) - (goto-char (cdaadr state))) - (backward-word))))) + (back-to-indentation))) (defun ruby-beginning-of-block (&optional arg) "Move backward to the beginning of the current block. === modified file 'lisp/window.el' --- lisp/window.el 2012-11-03 10:47:03 +0000 +++ lisp/window.el 2012-11-11 01:47:56 +0000 @@ -143,37 +143,36 @@ window)))) (defmacro with-temp-buffer-window (buffer-or-name action quit-function &rest body) - "Evaluate BODY and display buffer specified by BUFFER-OR-NAME. -BUFFER-OR-NAME must specify either a live buffer or the name of a -buffer. If no buffer with such a name exists, create one. + "Evaluate BODY and display the buffer specified by BUFFER-OR-NAME. +BUFFER-OR-NAME must specify either a live buffer, or the name of a +buffer (if it does not exist, this macro creates it). Make sure the specified buffer is empty before evaluating BODY. Do not make that buffer current for BODY. Instead, bind `standard-output' to that buffer, so that output generated with `prin1' and similar functions in BODY goes into that buffer. -After evaluating BODY, mark the specified buffer unmodified and -read-only, and display it in a window via `display-buffer'. Pass -ACTION as action argument to `display-buffer'. Automatically -shrink the window used if `temp-buffer-resize-mode' is enabled. +After evaluating BODY, this marks the specified buffer unmodified and +read-only, and displays it in a window via `display-buffer', passing +ACTION as the action argument to `display-buffer'. It automatically +shrinks the relevant window if `temp-buffer-resize-mode' is enabled. -Return the value returned by BODY unless QUIT-FUNCTION specifies -a function. In that case, run the function with two arguments - +Returns the value returned by BODY, unless QUIT-FUNCTION specifies +a function. In that case, runs the function with two arguments - the window showing the specified buffer and the value returned by -BODY - and return the value returned by that function. +BODY - and returns the value returned by that function. If the buffer is displayed on a new frame, the window manager may decide to select that frame. In that case, it's usually a good strategy if the function specified by QUIT-FUNCTION selects the window showing the buffer before reading a value from the -minibuffer, for example, when asking a `yes-or-no-p' question. +minibuffer; for example, when asking a `yes-or-no-p' question. -This construct is similar to `with-output-to-temp-buffer' but -does neither put the buffer in help mode nor does it call -`temp-buffer-show-function'. It also runs different hooks, -namely `temp-buffer-window-setup-hook' (with the specified buffer -current) and `temp-buffer-window-show-hook' (with the specified -buffer current and the window showing it selected). +This construct is similar to `with-output-to-temp-buffer', but does +not put the buffer in help mode, or call `temp-buffer-show-function'. +It also runs different hooks, namely `temp-buffer-window-setup-hook' +\(with the specified buffer current) and `temp-buffer-window-show-hook' +\(with the specified buffer current and the window showing it selected). Since this macro calls `display-buffer', the window displaying the buffer is usually not selected and the specified buffer @@ -6065,7 +6064,7 @@ window. The height of the root window is subject to the values of `fit-frame-to-buffer-max-height' and `window-min-height'." :type 'boolean - :version "24.2" + :version "24.3" :group 'help) (defcustom fit-frame-to-buffer-bottom-margin 4 @@ -6073,7 +6072,7 @@ This is the number of lines `fit-frame-to-buffer' leaves free at the bottom of the display in order to not obscure the system task bar." :type 'integer - :version "24.2" + :version "24.3" :group 'windows) (defun fit-frame-to-buffer (&optional frame max-height min-height) === modified file 'src/ChangeLog' --- src/ChangeLog 2012-11-13 01:35:14 +0000 +++ src/ChangeLog 2012-11-13 02:25:59 +0000 @@ -1,3 +1,11 @@ +2012-11-13 Eli Zaretskii + + * xdisp.c (decode_mode_spec): Limit the value of WIDTH argument + passed to pint2str and pint2hrstr to be at most the size of the + frame's decode_mode_spec_buffer. This avoids crashes with very + large values of FIELD_WIDTH argument to decode_mode_spec. + (Bug#12867) + 2012-11-13 Paul Eggert Fix a race with verify-visited-file-modtime (Bug#12863). === modified file 'src/xdisp.c' --- src/xdisp.c 2012-11-12 04:00:55 +0000 +++ src/xdisp.c 2012-11-13 02:25:59 +0000 @@ -21371,6 +21371,12 @@ Lisp_Object obj; struct frame *f = XFRAME (WINDOW_FRAME (w)); char *decode_mode_spec_buf = f->decode_mode_spec_buffer; + /* We are going to use f->decode_mode_spec_buffer as the buffer to + produce strings from numerical values, so limit preposterously + large values of FIELD_WIDTH to avoid overrunning the buffer's + end. The size of the buffer is enough for FRAME_MESSAGE_BUF_SIZE + bytes plus the terminating null. */ + int width = min (field_width, FRAME_MESSAGE_BUF_SIZE (f)); struct buffer *b = current_buffer; obj = Qnil; @@ -21466,7 +21472,7 @@ { ptrdiff_t col = current_column (); wset_column_number_displayed (w, make_number (col)); - pint2str (decode_mode_spec_buf, field_width, col); + pint2str (decode_mode_spec_buf, width, col); return decode_mode_spec_buf; } @@ -21497,14 +21503,14 @@ case 'i': { ptrdiff_t size = ZV - BEGV; - pint2str (decode_mode_spec_buf, field_width, size); + pint2str (decode_mode_spec_buf, width, size); return decode_mode_spec_buf; } case 'I': { ptrdiff_t size = ZV - BEGV; - pint2hrstr (decode_mode_spec_buf, field_width, size); + pint2hrstr (decode_mode_spec_buf, width, size); return decode_mode_spec_buf; } @@ -21611,12 +21617,12 @@ line_number_displayed = 1; /* Make the string to show. */ - pint2str (decode_mode_spec_buf, field_width, topline + nlines); + pint2str (decode_mode_spec_buf, width, topline + nlines); return decode_mode_spec_buf; no_value: { char* p = decode_mode_spec_buf; - int pad = field_width - 2; + int pad = width - 2; while (pad-- > 0) *p++ = ' '; *p++ = '?'; === modified file 'test/automated/ruby-mode-tests.el' --- test/automated/ruby-mode-tests.el 2012-09-18 22:10:19 +0000 +++ test/automated/ruby-mode-tests.el 2012-11-12 01:11:06 +0000 @@ -202,13 +202,13 @@ | end |")) -(ert-deftest ruby-move-to-block-stops-at-opening () +(ert-deftest ruby-move-to-block-stops-at-indentation () (with-temp-buffer (insert "def f\nend") (beginning-of-line) (ruby-mode) (ruby-move-to-block -1) - (should (looking-at "f$")))) + (should (looking-at "^def")))) (ert-deftest ruby-toggle-block-to-do-end () (with-temp-buffer ------------------------------------------------------------ revno: 110875 fixes bug: http://debbugs.gnu.org/12863 committer: Paul Eggert branch nick: trunk timestamp: Mon 2012-11-12 17:35:14 -0800 message: Fix a race with verify-visited-file-modtime. Since at least 1991 Emacs has ignored an mtime difference of no more than one second, but my guess is that this was to work around file system bugs that were fixed long ago. Since the race is causing problems now, let's remove that code. * fileio.c (Fverify_visited_file_modtime): Do not accept a file whose time stamp is off by no more than a second. Insist that the file time stamps match exactly. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-11-12 16:02:46 +0000 +++ src/ChangeLog 2012-11-13 01:35:14 +0000 @@ -1,3 +1,14 @@ +2012-11-13 Paul Eggert + + Fix a race with verify-visited-file-modtime (Bug#12863). + Since at least 1991 Emacs has ignored an mtime difference of no + more than one second, but my guess is that this was to work around + file system bugs that were fixed long ago. Since the race is + causing problems now, let's remove that code. + * fileio.c (Fverify_visited_file_modtime): Do not accept a file + whose time stamp is off by no more than a second. Insist that the + file time stamps match exactly. + 2012-11-12 Dmitry Antipov * frame.h (struct frame): Convert external_tool_bar member to === modified file 'src/fileio.c' --- src/fileio.c 2012-10-19 19:25:18 +0000 +++ src/fileio.c 2012-11-13 01:35:14 +0000 @@ -5076,7 +5076,7 @@ struct stat st; Lisp_Object handler; Lisp_Object filename; - EMACS_TIME mtime, diff; + EMACS_TIME mtime; if (NILP (buf)) b = current_buffer; @@ -5101,13 +5101,7 @@ mtime = (stat (SSDATA (filename), &st) == 0 ? get_stat_mtime (&st) : time_error_value (errno)); - if ((EMACS_TIME_EQ (mtime, b->modtime) - /* If both exist, accept them if they are off by one second. */ - || (EMACS_TIME_VALID_P (mtime) && EMACS_TIME_VALID_P (b->modtime) - && ((diff = (EMACS_TIME_LT (mtime, b->modtime) - ? sub_emacs_time (b->modtime, mtime) - : sub_emacs_time (mtime, b->modtime))), - EMACS_TIME_LE (diff, make_emacs_time (1, 0))))) + if (EMACS_TIME_EQ (mtime, b->modtime) && (st.st_size == b->modtime_size || b->modtime_size < 0)) return Qt; ------------------------------------------------------------ revno: 110874 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2012-11-12 15:43:43 -0500 message: * lisp/emacs-lisp/nadvice.el: New package. * lisp/subr.el (special-form-p): New function. * lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add. (elp-all-instrumented-list): Remove var. (elp-not-profilable): Remove elp-wrapper. (elp-profilable-p): Use autoloadp and special-form-p. (elp--advice-name): New const. (elp-instrument-function): Use advice-add. (elp--instrumented-p): New predicate. (elp-restore-function): Use advice-remove. (elp-restore-all, elp-reset-all): Use mapatoms. (elp-set-master): Use elp--instrumented-p. (elp--make-wrapper): Rename from elp-wrapper, return a function suitable for advice-add. Use cl-inf. (elp-results): Use mapatoms+elp--instrumented-p. * lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add. (debug-function-list): Remove var. (debug): Rename arg, and then let-bind it explicitly inside. (debugger-setup-buffer): Rename arg. (debugger-setup-buffer): Adjust counts to new debug-on-entry setup. (debugger-frame-number): Adjust to new debug-on-entry setup. (debug--implement-debug-on-entry): Rename from implement-debug-on-entry, add argument. (debugger-special-form-p): Remove, use special-form-p instead. (debug-on-entry): Use advice-add. (debug--function-list): New function. (cancel-debug-on-entry): Use it, along with advice-remove. (debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove. (debugger-list-functions): Use debug--function-list instead of debug-function-list. * lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused. (ad-special-form-p): Remove, use special-form-p instead. (ad-set-advice-info): Use add-function and remove-function. (ad--defalias-fset): Adjust accordingly. * test/automated/advice-tests.el: New tests. diff: === modified file 'etc/NEWS' --- etc/NEWS 2012-11-10 23:13:33 +0000 +++ etc/NEWS 2012-11-12 20:43:43 +0000 @@ -27,6 +27,13 @@ * Editing Changes in Emacs 24.4 * Changes in Specialized Modes and Packages in Emacs 24.4 * New Modes and Packages in Emacs 24.4 +** New nadvice.el package offering lighter-weight advice facilities. +It is layered as: +- add-function/remove-function which can be used to add/remove code on any + function-carrying place, such as process-filters or `-function' hooks. +- advice-add/advice-remove to add/remove a piece of advice on a named function, + much like `defadvice' does. + * Incompatible Lisp Changes in Emacs 24.4 ** `dolist' in lexical-binding mode does not bind VAR in RESULT any more. @@ -35,6 +42,7 @@ * Lisp changes in Emacs 24.4 +** New function special-form-p. ** Docstrings can be made dynamic by adding a `dynamic-docstring-function' text-property on the first char. === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-11-10 23:19:43 +0000 +++ lisp/ChangeLog 2012-11-12 20:43:43 +0000 @@ -1,3 +1,40 @@ +2012-11-12 Stefan Monnier + + * emacs-lisp/nadvice.el: New package. + * subr.el (special-form-p): New function. + * emacs-lisp/elp.el: Use lexical-binding and advice-add. + (elp-all-instrumented-list): Remove var. + (elp-not-profilable): Remove elp-wrapper. + (elp-profilable-p): Use autoloadp and special-form-p. + (elp--advice-name): New const. + (elp-instrument-function): Use advice-add. + (elp--instrumented-p): New predicate. + (elp-restore-function): Use advice-remove. + (elp-restore-all, elp-reset-all): Use mapatoms. + (elp-set-master): Use elp--instrumented-p. + (elp--make-wrapper): Rename from elp-wrapper, return a function + suitable for advice-add. Use cl-inf. + (elp-results): Use mapatoms+elp--instrumented-p. + * emacs-lisp/debug.el: Use lexical-binding and advice-add. + (debug-function-list): Remove var. + (debug): Rename arg, and then let-bind it explicitly inside. + (debugger-setup-buffer): Rename arg. + (debugger-setup-buffer): Adjust counts to new debug-on-entry setup. + (debugger-frame-number): Adjust to new debug-on-entry setup. + (debug--implement-debug-on-entry): Rename from + implement-debug-on-entry, add argument. + (debugger-special-form-p): Remove, use special-form-p instead. + (debug-on-entry): Use advice-add. + (debug--function-list): New function. + (cancel-debug-on-entry): Use it, along with advice-remove. + (debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove. + (debugger-list-functions): Use debug--function-list instead of + debug-function-list. + * emacs-lisp/advice.el (ad-save-real-definition): Remove, unused. + (ad-special-form-p): Remove, use special-form-p instead. + (ad-set-advice-info): Use add-function and remove-function. + (ad--defalias-fset): Adjust accordingly. + 2012-11-10 Glenn Morris * mail/emacsbug.el (report-emacs-bug-tracker-url) === modified file 'lisp/emacs-lisp/advice.el' --- lisp/emacs-lisp/advice.el 2012-11-10 23:13:33 +0000 +++ lisp/emacs-lisp/advice.el 2012-11-12 20:43:43 +0000 @@ -1776,27 +1776,6 @@ (funcall fUnCtIoN tReE)) (t tReE))) -;; @@ Save real definitions of subrs used by Advice: -;; ================================================= -;; Advice depends on the real, unmodified functionality of various subrs, -;; we save them here so advised versions will not interfere (eventually, -;; we will save all subrs used in code generated by Advice): - -(defmacro ad-save-real-definition (function) - (let ((saved-function (intern (format "ad-real-%s" function)))) - ;; Make sure the compiler is loaded during macro expansion: - (require 'byte-compile "bytecomp") - `(if (not (fboundp ',saved-function)) - (progn (fset ',saved-function (symbol-function ',function)) - ;; Copy byte-compiler properties: - ,@(if (get function 'byte-compile) - `((put ',saved-function 'byte-compile - ',(get function 'byte-compile)))) - ,@(if (get function 'byte-opcode) - `((put ',saved-function 'byte-opcode - ',(get function 'byte-opcode)))))))) - - ;; @@ Advice info access fns: ;; ========================== @@ -1849,9 +1828,12 @@ (defsubst ad-set-advice-info (function advice-info) (cond - (advice-info (put function 'defalias-fset-function #'ad--defalias-fset)) + (advice-info + (add-function :around (get function 'defalias-fset-function) + #'ad--defalias-fset)) ((get function 'defalias-fset-function) - (put function 'defalias-fset-function nil))) + (remove-function (get function 'defalias-fset-function) + #'ad--defalias-fset))) (put function 'ad-advice-info advice-info)) (defmacro ad-copy-advice-info (function) @@ -1974,8 +1956,8 @@ ;; to `ad-activate' by using `ad-with-auto-activation-disabled' where ;; appropriate, especially in a safe version of `fset'. -(defun ad--defalias-fset (function definition) - (fset function definition) +(defun ad--defalias-fset (fsetfun function definition) + (funcall (or fsetfun #'fset) function definition) (ad-activate-internal function nil)) ;; For now define `ad-activate-internal' to the dummy definition: @@ -2310,12 +2292,6 @@ "Take a macro function DEFINITION and make a lambda out of it." `(cdr ,definition)) -(defun ad-special-form-p (definition) - "Non-nil if and only if DEFINITION is a special form." - (if (and (symbolp definition) (fboundp definition)) - (setq definition (indirect-function definition))) - (and (subrp definition) (eq (cdr (subr-arity definition)) 'unevalled))) - (defmacro ad-subr-p (definition) ;;"non-nil if DEFINITION is a subr." (list 'subrp definition)) @@ -2415,7 +2391,7 @@ (cond ((ad-macro-p definition) 'macro) ((ad-subr-p definition) - (if (ad-special-form-p definition) + (if (special-form-p definition) 'special-form 'subr)) ((or (ad-lambda-p definition) @@ -2804,7 +2780,7 @@ (origname (ad-get-advice-info-field function 'origname)) (orig-interactive-p (commandp origdef)) (orig-subr-p (ad-subr-p origdef)) - (orig-special-form-p (ad-special-form-p origdef)) + (orig-special-form-p (special-form-p origdef)) (orig-macro-p (ad-macro-p origdef)) ;; Construct the individual pieces that we need for assembly: (orig-arglist (ad-arglist origdef)) === modified file 'lisp/emacs-lisp/debug.el' --- lisp/emacs-lisp/debug.el 2012-10-19 09:28:50 +0000 +++ lisp/emacs-lisp/debug.el 2012-11-12 20:43:43 +0000 @@ -1,4 +1,4 @@ -;;; debug.el --- debuggers and related commands for Emacs +;;; debug.el --- debuggers and related commands for Emacs -*- lexical-binding: t -*- ;; Copyright (C) 1985-1986, 1994, 2001-2012 Free Software Foundation, Inc. @@ -81,9 +81,6 @@ :group 'debugger :version "24.2") -(defvar debug-function-list nil - "List of functions currently set for debug on entry.") - (defvar debugger-step-after-exit nil "Non-nil means \"single-step\" after the debugger exits.") @@ -146,7 +143,7 @@ ;;;###autoload (setq debugger 'debug) ;;;###autoload -(defun debug (&rest debugger-args) +(defun debug (&rest args) "Enter debugger. \\`\\[debugger-continue]' returns from the debugger. Arguments are mainly for use when this is called from the internals of the evaluator. @@ -165,6 +162,7 @@ (if (get-buffer "*Backtrace*") (with-current-buffer (get-buffer "*Backtrace*") (list major-mode (buffer-string))))) + (debugger-args args) (debugger-buffer (get-buffer-create "*Backtrace*")) (debugger-old-buffer (current-buffer)) (debugger-window nil) @@ -219,7 +217,7 @@ (save-excursion (when (eq (car debugger-args) 'debug) ;; Skip the frames for backtrace-debug, byte-code, - ;; and implement-debug-on-entry. + ;; debug--implement-debug-on-entry and the advice's `apply'. (backtrace-debug 4 t) ;; Place an extra debug-on-exit for macro's. (when (eq 'lambda (car-safe (cadr (backtrace-frame 4)))) @@ -318,7 +316,7 @@ (setq debug-on-next-call debugger-step-after-exit) debugger-value))) -(defun debugger-setup-buffer (debugger-args) +(defun debugger-setup-buffer (args) "Initialize the `*Backtrace*' buffer for entry to the debugger. That buffer should be current already." (setq buffer-read-only nil) @@ -334,20 +332,22 @@ (delete-region (point) (progn (search-forward "\n debug(") - (forward-line (if (eq (car debugger-args) 'debug) - 2 ; Remove implement-debug-on-entry frame. + (forward-line (if (eq (car args) 'debug) + ;; Remove debug--implement-debug-on-entry + ;; and the advice's `apply' frame. + 3 1)) (point))) (insert "Debugger entered") ;; lambda is for debug-on-call when a function call is next. ;; debug is for debug-on-entry function called. - (pcase (car debugger-args) + (pcase (car args) ((or `lambda `debug) (insert "--entering a function:\n")) ;; Exiting a function. (`exit (insert "--returning value: ") - (setq debugger-value (nth 1 debugger-args)) + (setq debugger-value (nth 1 args)) (prin1 debugger-value (current-buffer)) (insert ?\n) (delete-char 1) @@ -356,7 +356,7 @@ ;; Debugger entered for an error. (`error (insert "--Lisp error: ") - (prin1 (nth 1 debugger-args) (current-buffer)) + (prin1 (nth 1 args) (current-buffer)) (insert ?\n)) ;; debug-on-call, when the next thing is an eval. (`t @@ -364,8 +364,8 @@ ;; User calls debug directly. (_ (insert ": ") - (prin1 (if (eq (car debugger-args) 'nil) - (cdr debugger-args) debugger-args) + (prin1 (if (eq (car args) 'nil) + (cdr args) args) (current-buffer)) (insert ?\n))) ;; After any frame that uses eval-buffer, @@ -525,9 +525,10 @@ (count 0)) (while (not (eq (cadr (backtrace-frame count)) 'debug)) (setq count (1+ count))) - ;; Skip implement-debug-on-entry frame. - (when (eq 'implement-debug-on-entry (cadr (backtrace-frame (1+ count)))) - (setq count (1+ count))) + ;; Skip debug--implement-debug-on-entry frame. + (when (eq 'debug--implement-debug-on-entry + (cadr (backtrace-frame (1+ count)))) + (setq count (+ 2 count))) (goto-char (point-min)) (when (looking-at "Debugger entered--\\(Lisp error\\|returning value\\):") (goto-char (match-end 0)) @@ -694,10 +695,10 @@ :help "Continue to exit from this frame, with all debug-on-entry suspended")) (define-key menu-map [deb-cont] '(menu-item "Continue" debugger-continue - :help "Continue, evaluating this expression without stopping")) + :help "Continue, evaluating this expression without stopping")) (define-key menu-map [deb-step] '(menu-item "Step through" debugger-step-through - :help "Proceed, stepping through subexpressions of this expression")) + :help "Proceed, stepping through subexpressions of this expression")) map)) (put 'debugger-mode 'mode-class 'special) @@ -777,7 +778,7 @@ ;; When you change this, you may also need to change the number of ;; frames that the debugger skips. -(defun implement-debug-on-entry () +(defun debug--implement-debug-on-entry (&rest _ignore) "Conditionally call the debugger. A call to this function is inserted by `debug-on-entry' to cause functions to break on entry." @@ -785,12 +786,6 @@ nil (funcall debugger 'debug))) -(defun debugger-special-form-p (symbol) - "Return whether SYMBOL is a special form." - (and (fboundp symbol) - (subrp (symbol-function symbol)) - (eq (cdr (subr-arity (symbol-function symbol))) 'unevalled))) - ;;;###autoload (defun debug-on-entry (function) "Request FUNCTION to invoke debugger each time it is called. @@ -808,7 +803,7 @@ Redefining FUNCTION also cancels it." (interactive (let ((fn (function-called-at-point)) val) - (when (debugger-special-form-p fn) + (when (special-form-p fn) (setq fn nil)) (setq val (completing-read (if fn @@ -817,36 +812,21 @@ obarray #'(lambda (symbol) (and (fboundp symbol) - (not (debugger-special-form-p symbol)))) + (not (special-form-p symbol)))) t nil nil (symbol-name fn))) (list (if (equal val "") fn (intern val))))) - ;; FIXME: Use advice.el. - (when (debugger-special-form-p function) - (error "Function %s is a special form" function)) - (if (or (symbolp (symbol-function function)) - (subrp (symbol-function function))) - ;; The function is built-in or aliased to another function. - ;; Create a wrapper in which we can add the debug call. - (fset function `(lambda (&rest debug-on-entry-args) - ,(interactive-form (symbol-function function)) - (apply ',(symbol-function function) - debug-on-entry-args))) - (when (autoloadp (symbol-function function)) - ;; The function is autoloaded. Load its real definition. - (autoload-do-load (symbol-function function) function)) - (when (or (not (consp (symbol-function function))) - (and (eq (car (symbol-function function)) 'macro) - (not (consp (cdr (symbol-function function)))))) - ;; The function is byte-compiled. Create a wrapper in which - ;; we can add the debug call. - (debug-convert-byte-code function))) - (unless (consp (symbol-function function)) - (error "Definition of %s is not a list" function)) - (fset function (debug-on-entry-1 function t)) - (unless (memq function debug-function-list) - (push function debug-function-list)) + (advice-add function :before #'debug--implement-debug-on-entry) function) +(defun debug--function-list () + "List of functions currently set for debug on entry." + (let ((funs '())) + (mapatoms + (lambda (s) + (when (advice-member-p #'debug--implement-debug-on-entry s) + (push s funs)))) + funs)) + ;;;###autoload (defun cancel-debug-on-entry (&optional function) "Undo effect of \\[debug-on-entry] on FUNCTION. @@ -857,80 +837,16 @@ (list (let ((name (completing-read "Cancel debug on entry to function (default all functions): " - (mapcar 'symbol-name debug-function-list) nil t))) + (mapcar #'symbol-name (debug--function-list)) nil t))) (when name (unless (string= name "") (intern name)))))) - (if (and function - (not (string= function ""))) ; Pre 22.1 compatibility test. + (if function (progn - (let ((defn (debug-on-entry-1 function nil))) - (condition-case nil - (when (and (equal (nth 1 defn) '(&rest debug-on-entry-args)) - (eq (car (nth 3 defn)) 'apply)) - ;; `defn' is a wrapper introduced in debug-on-entry. - ;; Get rid of it since we don't need it any more. - (setq defn (nth 1 (nth 1 (nth 3 defn))))) - (error nil)) - (fset function defn)) - (setq debug-function-list (delq function debug-function-list)) + (advice-remove function #'debug--implement-debug-on-entry) function) (message "Cancelling debug-on-entry for all functions") - (mapcar 'cancel-debug-on-entry debug-function-list))) - -(defun debug-arglist (definition) - ;; FIXME: copied from ad-arglist. - "Return the argument list of DEFINITION." - (require 'help-fns) - (help-function-arglist definition 'preserve-names)) - -(defun debug-convert-byte-code (function) - (let* ((defn (symbol-function function)) - (macro (eq (car-safe defn) 'macro))) - (when macro (setq defn (cdr defn))) - (when (byte-code-function-p defn) - (let* ((args (debug-arglist defn)) - (body - `((,(if (memq '&rest args) #'apply #'funcall) - ,defn - ,@(remq '&rest (remq '&optional args)))))) - (if (> (length defn) 5) - ;; The mere presence of field 5 is sufficient to make - ;; it interactive. - (push `(interactive ,(aref defn 5)) body)) - (if (and (> (length defn) 4) (aref defn 4)) - ;; Use `documentation' here, to get the actual string, - ;; in case the compiled function has a reference - ;; to the .elc file. - (setq body (cons (documentation function) body))) - (setq defn `(closure (t) ,args ,@body))) - (when macro (setq defn (cons 'macro defn))) - (fset function defn)))) - -(defun debug-on-entry-1 (function flag) - (let* ((defn (symbol-function function)) - (tail defn)) - (when (eq (car-safe tail) 'macro) - (setq tail (cdr tail))) - (if (not (memq (car-safe tail) '(closure lambda))) - ;; Only signal an error when we try to set debug-on-entry. - ;; When we try to clear debug-on-entry, we are now done. - (when flag - (error "%s is not a user-defined Lisp function" function)) - (if (eq (car tail) 'closure) (setq tail (cdr tail))) - (setq tail (cdr tail)) - ;; Skip the docstring. - (when (and (stringp (cadr tail)) (cddr tail)) - (setq tail (cdr tail))) - ;; Skip the interactive form. - (when (eq 'interactive (car-safe (cadr tail))) - (setq tail (cdr tail))) - (unless (eq flag (equal (cadr tail) '(implement-debug-on-entry))) - ;; Add/remove debug statement as needed. - (setcdr tail (if flag - (cons '(implement-debug-on-entry) (cdr tail)) - (cddr tail))))) - defn)) + (mapcar #'cancel-debug-on-entry (debug--function-list)))) (defun debugger-list-functions () "Display a list of all the functions now set to debug on entry." @@ -940,17 +856,18 @@ (called-interactively-p 'interactive)) (with-output-to-temp-buffer (help-buffer) (with-current-buffer standard-output - (if (null debug-function-list) - (princ "No debug-on-entry functions now\n") - (princ "Functions set to debug on entry:\n\n") - (dolist (fun debug-function-list) - (make-text-button (point) (progn (prin1 fun) (point)) - 'type 'help-function - 'help-args (list fun)) - (terpri)) - (terpri) - (princ "Note: if you have redefined a function, then it may no longer\n") - (princ "be set to debug on entry, even if it is in the list."))))) + (let ((funs (debug--function-list))) + (if (null funs) + (princ "No debug-on-entry functions now\n") + (princ "Functions set to debug on entry:\n\n") + (dolist (fun funs) + (make-text-button (point) (progn (prin1 fun) (point)) + 'type 'help-function + 'help-args (list fun)) + (terpri)) + (terpri) + (princ "Note: if you have redefined a function, then it may no longer\n") + (princ "be set to debug on entry, even if it is in the list.")))))) (provide 'debug) === modified file 'lisp/emacs-lisp/elp.el' --- lisp/emacs-lisp/elp.el 2012-07-26 01:27:33 +0000 +++ lisp/emacs-lisp/elp.el 2012-11-12 20:43:43 +0000 @@ -1,4 +1,4 @@ -;;; elp.el --- Emacs Lisp Profiler +;;; elp.el --- Emacs Lisp Profiler -*- lexical-binding: t -*- ;; Copyright (C) 1994-1995, 1997-1998, 2001-2012 ;; Free Software Foundation, Inc. @@ -124,6 +124,7 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) ;; start of user configuration variables ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv @@ -148,9 +149,9 @@ "Non-nil specifies ELP results sorting function. These functions are currently available: - elp-sort-by-call-count -- sort by the highest call count - elp-sort-by-total-time -- sort by the highest total time - elp-sort-by-average-time -- sort by the highest average times + `elp-sort-by-call-count' -- sort by the highest call count + `elp-sort-by-total-time' -- sort by the highest total time + `elp-sort-by-average-time' -- sort by the highest average times You can write your own sort function. It should adhere to the interface specified by the PREDICATE argument for `sort'. @@ -167,7 +168,7 @@ of times will be displayed in the output buffer. If nil, all functions will be displayed." :type '(choice integer - (const :tag "Show All" nil)) + (const :tag "Show All" nil)) :group 'elp) (defcustom elp-use-standard-output nil @@ -193,9 +194,6 @@ (defconst elp-timer-info-property 'elp-info "ELP information property name.") -(defvar elp-all-instrumented-list nil - "List of all functions currently being instrumented.") - (defvar elp-record-p t "Controls whether functions should record times or not. This variable is set by the master function.") @@ -205,7 +203,7 @@ (defvar elp-not-profilable ;; First, the functions used inside each instrumented function: - '(elp-wrapper called-interactively-p + '(called-interactively-p ;; Then the functions used by the above functions. I used ;; (delq nil (mapcar (lambda (x) (and (symbolp x) (fboundp x) x)) ;; (aref (symbol-function 'elp-wrapper) 2))) @@ -223,60 +221,21 @@ (fboundp fun) (not (or (memq fun elp-not-profilable) (keymapp fun) - (memq (car-safe (symbol-function fun)) '(autoload macro)) - (condition-case nil - (when (subrp (indirect-function fun)) - (eq 'unevalled - (cdr (subr-arity (indirect-function fun))))) - (error nil)))))) + (autoloadp (symbol-function fun)) ;FIXME: Why not just load it? + (special-form-p fun))))) +(defconst elp--advice-name 'ELP-instrumentation\ ) ;;;###autoload (defun elp-instrument-function (funsym) "Instrument FUNSYM for profiling. FUNSYM must be a symbol of a defined function." (interactive "aFunction to instrument: ") - ;; restore the function. this is necessary to avoid infinite - ;; recursion of already instrumented functions (i.e. elp-wrapper - ;; calling elp-wrapper ad infinitum). it is better to simply - ;; restore the function than to throw an error. this will work - ;; properly in the face of eval-defun because if the function was - ;; redefined, only the timer info will be nil'd out since - ;; elp-restore-function is smart enough not to trash the new - ;; definition. - (elp-restore-function funsym) - (let* ((funguts (symbol-function funsym)) - (infovec (vector 0 0 funguts)) - (newguts '(lambda (&rest args)))) - ;; we cannot profile macros - (and (eq (car-safe funguts) 'macro) - (error "ELP cannot profile macro: %s" funsym)) - ;; TBD: at some point it might be better to load the autoloaded - ;; function instead of throwing an error. if we do this, then we - ;; probably want elp-instrument-package to be updated with the - ;; newly loaded list of functions. i'm not sure it's smart to do - ;; the autoload here, since that could have side effects, and - ;; elp-instrument-function is similar (in my mind) to defun-ish - ;; type functionality (i.e. it shouldn't execute the function). - (and (autoloadp funguts) - (error "ELP cannot profile autoloaded function: %s" funsym)) + (let* ((infovec (vector 0 0))) ;; We cannot profile functions used internally during profiling. (unless (elp-profilable-p funsym) (error "ELP cannot profile the function: %s" funsym)) - ;; put rest of newguts together - (if (commandp funsym) - (setq newguts (append newguts '((interactive))))) - (setq newguts (append newguts `((elp-wrapper - (quote ,funsym) - ,(when (commandp funsym) - '(called-interactively-p 'any)) - args)))) - ;; to record profiling times, we set the symbol's function - ;; definition so that it runs the elp-wrapper function with the - ;; function symbol as an argument. We place the old function - ;; definition on the info vector. - ;; - ;; The info vector data structure is a 3 element vector. The 0th + ;; The info vector data structure is a 2 element vector. The 0th ;; element is the call-count, i.e. the total number of times this ;; function has been entered. This value is bumped up on entry to ;; the function so that non-local exists are still recorded. TBD: @@ -285,72 +244,45 @@ ;; The 1st element is the total amount of time in seconds that has ;; been spent inside this function. This number is added to on ;; function exit. - ;; - ;; The 2nd element is the old function definition list. This gets - ;; funcall'd in between start/end time retrievals. I believe that - ;; this lets us profile even byte-compiled functions. - ;; put the info vector on the property list + ;; Put the info vector on the property list. (put funsym elp-timer-info-property infovec) ;; Set the symbol's new profiling function definition to run - ;; elp-wrapper. - (let ((advice-info (get funsym 'ad-advice-info))) - (if advice-info - (progn - ;; If function is advised, don't let Advice change - ;; its definition from under us during the `fset'. - (put funsym 'ad-advice-info nil) - (fset funsym newguts) - (put funsym 'ad-advice-info advice-info)) - (fset funsym newguts))) + ;; ELP wrapper. + (advice-add funsym :around (elp--make-wrapper funsym) + `((name . ,elp--advice-name))))) - ;; add this function to the instrumentation list - (unless (memq funsym elp-all-instrumented-list) - (push funsym elp-all-instrumented-list)))) +(defun elp--instrumented-p (sym) + (advice-member-p elp--advice-name sym)) (defun elp-restore-function (funsym) "Restore an instrumented function to its original definition. Argument FUNSYM is the symbol of a defined function." - (interactive "aFunction to restore: ") - (let ((info (get funsym elp-timer-info-property))) - ;; delete the function from the all instrumented list - (setq elp-all-instrumented-list - (delq funsym elp-all-instrumented-list)) - - ;; if the function was the master, reset the master - (if (eq funsym elp-master) - (setq elp-master nil - elp-record-p t)) - - ;; zap the properties - (put funsym elp-timer-info-property nil) - - ;; restore the original function definition, but if the function - ;; wasn't instrumented do nothing. we do this after the above - ;; because its possible the function got un-instrumented due to - ;; circumstances beyond our control. Also, check to make sure - ;; that the current function symbol points to elp-wrapper. If - ;; not, then the user probably did an eval-defun, or loaded a - ;; byte-compiled version, while the function was instrumented and - ;; we don't want to destroy the new definition. can it ever be - ;; the case that a lisp function can be compiled instrumented? - (and info - (functionp funsym) - (not (byte-code-function-p (symbol-function funsym))) - (assq 'elp-wrapper (symbol-function funsym)) - (fset funsym (aref info 2))))) + (interactive + (list + (intern + (completing-read "Function to restore: " obarray + #'elp--instrumented-p t)))) + ;; If the function was the master, reset the master. + (if (eq funsym elp-master) + (setq elp-master nil + elp-record-p t)) + + ;; Zap the properties. + (put funsym elp-timer-info-property nil) + + (advice-remove funsym elp--advice-name)) ;;;###autoload (defun elp-instrument-list (&optional list) "Instrument, for profiling, all functions in `elp-function-list'. Use optional LIST if provided instead. If called interactively, read LIST using the minibuffer." - (interactive "PList of functions to instrument: ") + (interactive "PList of functions to instrument: ") ;FIXME: Doesn't work?! (unless (listp list) (signal 'wrong-type-argument (list 'listp list))) - (let ((list (or list elp-function-list))) - (mapcar 'elp-instrument-function list))) + (mapcar #'elp-instrument-function (or list elp-function-list))) ;;;###autoload (defun elp-instrument-package (prefix) @@ -371,15 +303,13 @@ (defun elp-restore-list (&optional list) "Restore the original definitions for all functions in `elp-function-list'. Use optional LIST if provided instead." - (interactive "PList of functions to restore: ") - (let ((list (or list elp-function-list))) - (mapcar 'elp-restore-function list))) + (interactive "PList of functions to restore: ") ;FIXME: Doesn't work!? + (mapcar #'elp-restore-function (or list elp-function-list))) (defun elp-restore-all () "Restore the original definitions of all functions being profiled." (interactive) - (elp-restore-list elp-all-instrumented-list)) - + (mapatoms #'elp-restore-function)) (defun elp-reset-function (funsym) "Reset the profiling information for FUNSYM." @@ -395,30 +325,36 @@ (defun elp-reset-list (&optional list) "Reset the profiling information for all functions in `elp-function-list'. Use optional LIST if provided instead." - (interactive "PList of functions to reset: ") + (interactive "PList of functions to reset: ") ;FIXME: Doesn't work!? (let ((list (or list elp-function-list))) (mapcar 'elp-reset-function list))) (defun elp-reset-all () "Reset the profiling information for all functions being profiled." (interactive) - (elp-reset-list elp-all-instrumented-list)) + (mapatoms (lambda (sym) + (if (get sym elp-timer-info-property) + (elp-reset-function sym))))) (defun elp-set-master (funsym) "Set the master function for profiling." - (interactive "aMaster function: ") - ;; when there's a master function, recording is turned off by - ;; default + (interactive + (list + (intern + (completing-read "Master function: " obarray + #'elp--instrumented-p + t nil nil (if elp-master (symbol-name elp-master)))))) + ;; When there's a master function, recording is turned off by default. (setq elp-master funsym elp-record-p nil) - ;; make sure master function is instrumented - (or (memq funsym elp-all-instrumented-list) + ;; Make sure master function is instrumented. + (or (elp--instrumented-p funsym) (elp-instrument-function funsym))) (defun elp-unset-master () "Unset the master function." (interactive) - ;; when there's no master function, recording is turned on by default. + ;; When there's no master function, recording is turned on by default. (setq elp-master nil elp-record-p t)) @@ -426,49 +362,40 @@ (defsubst elp-elapsed-time (start end) (float-time (time-subtract end start))) -(defun elp-wrapper (funsym interactive-p args) - "This function has been instrumented for profiling by the ELP. +(defun elp--make-wrapper (funsym) + "Make the piece of advice that instruments FUNSYM." + (lambda (func &rest args) + "This function has been instrumented for profiling by the ELP. ELP is the Emacs Lisp Profiler. To restore the function to its original definition, use \\[elp-restore-function] or \\[elp-restore-all]." - ;; turn on recording if this is the master function - (if (and elp-master - (eq funsym elp-master)) - (setq elp-record-p t)) - ;; get info vector and original function symbol - (let* ((info (get funsym elp-timer-info-property)) - (func (aref info 2)) - result) - (or func - (error "%s is not instrumented for profiling" funsym)) - (if (not elp-record-p) - ;; when not recording, just call the original function symbol - ;; and return the results. - (setq result - (if interactive-p - (call-interactively func) - (apply func args))) - ;; we are recording times - (let (enter-time exit-time) - ;; increment the call-counter - (aset info 0 (1+ (aref info 0))) - ;; now call the old symbol function, checking to see if it - ;; should be called interactively. make sure we return the - ;; correct value - (if interactive-p - (setq enter-time (current-time) - result (call-interactively func) - exit-time (current-time)) + ;; turn on recording if this is the master function + (if (and elp-master + (eq funsym elp-master)) + (setq elp-record-p t)) + ;; get info vector and original function symbol + (let* ((info (get funsym elp-timer-info-property)) + result) + (or func + (error "%s is not instrumented for profiling" funsym)) + (if (not elp-record-p) + ;; when not recording, just call the original function symbol + ;; and return the results. + (setq result (apply func args)) + ;; we are recording times + (let (enter-time exit-time) + ;; increment the call-counter + (cl-incf (aref info 0)) (setq enter-time (current-time) result (apply func args) - exit-time (current-time))) - ;; calculate total time in function - (aset info 1 (+ (aref info 1) (elp-elapsed-time enter-time exit-time))) - )) - ;; turn off recording if this is the master function - (if (and elp-master - (eq funsym elp-master)) - (setq elp-record-p nil)) - result)) + exit-time (current-time)) + ;; calculate total time in function + (cl-incf (aref info 1) (elp-elapsed-time enter-time exit-time)) + )) + ;; turn off recording if this is the master function + (if (and elp-master + (eq funsym elp-master)) + (setq elp-record-p nil)) + result))) ;; shut the byte-compiler up @@ -582,57 +509,58 @@ (elp-et-len (length et-header)) (at-header "Average Time") (elp-at-len (length at-header)) - (resvec - (mapcar - (function - (lambda (funsym) - (let* ((info (get funsym elp-timer-info-property)) - (symname (format "%s" funsym)) - (cc (aref info 0)) - (tt (aref info 1))) - (if (not info) - (insert "No profiling information found for: " - symname) - (setq longest (max longest (length symname))) - (vector cc tt (if (zerop cc) - 0.0 ;avoid arithmetic div-by-zero errors - (/ (float tt) (float cc))) - symname))))) - elp-all-instrumented-list)) + (resvec '()) ) ; end let* + (mapatoms + (lambda (funsym) + (when (elp--instrumented-p funsym) + (let* ((info (get funsym elp-timer-info-property)) + (symname (format "%s" funsym)) + (cc (aref info 0)) + (tt (aref info 1))) + (if (not info) + (insert "No profiling information found for: " + symname) + (setq longest (max longest (length symname))) + (push + (vector cc tt (if (zerop cc) + 0.0 ;avoid arithmetic div-by-zero errors + (/ (float tt) (float cc))) + symname) + resvec)))))) ;; If printing to stdout, insert the header so it will print. ;; Otherwise use header-line-format. (setq elp-field-len (max titlelen longest)) (if (or elp-use-standard-output noninteractive) - (progn - (insert title) - (if (> longest titlelen) - (progn - (insert-char 32 (- longest titlelen)))) - (insert " " cc-header " " et-header " " at-header "\n") - (insert-char ?= elp-field-len) - (insert " ") - (insert-char ?= elp-cc-len) - (insert " ") - (insert-char ?= elp-et-len) - (insert " ") - (insert-char ?= elp-at-len) - (insert "\n")) - (let ((column 0)) - (setq header-line-format - (mapconcat - (lambda (title) - (prog1 - (concat - (propertize " " - 'display (list 'space :align-to column) - 'face 'fixed-pitch) - title) - (setq column (+ column 2 - (if (= column 0) - elp-field-len - (length title)))))) - (list title cc-header et-header at-header) "")))) + (progn + (insert title) + (if (> longest titlelen) + (progn + (insert-char 32 (- longest titlelen)))) + (insert " " cc-header " " et-header " " at-header "\n") + (insert-char ?= elp-field-len) + (insert " ") + (insert-char ?= elp-cc-len) + (insert " ") + (insert-char ?= elp-et-len) + (insert " ") + (insert-char ?= elp-at-len) + (insert "\n")) + (let ((column 0)) + (setq header-line-format + (mapconcat + (lambda (title) + (prog1 + (concat + (propertize " " + 'display (list 'space :align-to column) + 'face 'fixed-pitch) + title) + (setq column (+ column 2 + (if (= column 0) + elp-field-len + (length title)))))) + (list title cc-header et-header at-header) "")))) ;; if sorting is enabled, then sort the results list. in either ;; case, call elp-output-result to output the result in the ;; buffer @@ -644,7 +572,7 @@ (pop-to-buffer resultsbuf) ;; copy results to standard-output? (if (or elp-use-standard-output noninteractive) - (princ (buffer-substring (point-min) (point-max))) + (princ (buffer-substring (point-min) (point-max))) (goto-char (point-min))) ;; reset profiling info if desired (and elp-reset-after-results === added file 'lisp/emacs-lisp/nadvice.el' --- lisp/emacs-lisp/nadvice.el 1970-01-01 00:00:00 +0000 +++ lisp/emacs-lisp/nadvice.el 2012-11-12 20:43:43 +0000 @@ -0,0 +1,348 @@ +;;; nadvice.el --- Light-weight advice primitives for Elisp functions -*- lexical-binding: t -*- + +;; Copyright (C) 2012 Free Software Foundation, Inc. + +;; Author: Stefan Monnier +;; Keywords: extensions, lisp, tools +;; Package: emacs + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This package lets you add behavior (which we call "piece of advice") to +;; existing functions, like the old `advice.el' package, but with much fewer +;; bells ans whistles. It comes in 2 parts: +;; +;; - The first part lets you add/remove functions, similarly to +;; add/remove-hook, from any "place" (i.e. as accepted by `setf') that +;; holds a function. +;; This part provides mainly 2 macros: `add-function' and `remove-function'. +;; +;; - The second part provides `add-advice' and `remove-advice' which are +;; refined version of the previous macros specially tailored for the case +;; where the place that we want to modify is a `symbol-function'. + +;;; Code: + +;;;; Lightweight advice/hook +(defvar advice--where-alist + '((:around "\300\301\302\003#\207" 5) + (:before "\300\301\002\"\210\300\302\002\"\207" 4) + (:after "\300\302\002\"\300\301\003\"\210\207" 5) + (:after-until "\300\302\002\"\206\013\000\300\301\002\"\207" 4) + (:after-while "\300\302\002\"\205\013\000\300\301\002\"\207" 4) + (:before-until "\300\301\002\"\206\013\000\300\302\002\"\207" 4) + (:before-while "\300\301\002\"\205\013\000\300\302\002\"\207" 4)) + "List of descriptions of how to add a function. +Each element has the form (WHERE BYTECODE STACK) where: + WHERE is a keyword indicating where the function is added. + BYTECODE is the corresponding byte-code that will be used. + STACK is the amount of stack space needed by the byte-code.") + +(defvar advice--bytecodes (mapcar #'cadr advice--where-alist)) + +(defun advice--p (object) + (and (byte-code-function-p object) + (eq 128 (aref object 0)) + (memq (length object) '(5 6)) + (memq (aref object 1) advice--bytecodes) + (eq #'apply (aref (aref object 2) 0)))) + +(defsubst advice--car (f) (aref (aref f 2) 1)) +(defsubst advice--cdr (f) (aref (aref f 2) 2)) +(defsubst advice--props (f) (aref (aref f 2) 3)) + +(defun advice--make-docstring (_string function) + "Build the raw doc-string of SYMBOL, presumably advised." + (let ((flist (indirect-function function)) + (docstring nil)) + (if (eq 'macro (car-safe flist)) (setq flist (cdr flist))) + (while (advice--p flist) + (let ((bytecode (aref flist 1)) + (where nil)) + (dolist (elem advice--where-alist) + (if (eq bytecode (cadr elem)) (setq where (car elem)))) + (setq docstring + (concat + docstring + (propertize (format "%s advice: " where) + 'face 'warning) + (let ((fun (advice--car flist))) + (if (symbolp fun) (format "`%S'" fun) + (let* ((name (cdr (assq 'name (advice--props flist)))) + (doc (documentation fun t)) + (usage (help-split-fundoc doc function))) + (if usage (setq doc (cdr usage))) + (if name + (if doc + (format "%s\n%s" name doc) + (format "%s" name)) + (or doc "No documentation"))))) + "\n"))) + (setq flist (advice--cdr flist))) + (if docstring (setq docstring (concat docstring "\n"))) + (let* ((origdoc (unless (eq function flist) ;Avoid inf-loops. + (documentation flist t))) + (usage (help-split-fundoc origdoc function))) + (setq usage (if (null usage) + (let ((arglist (help-function-arglist flist))) + (format "%S" (help-make-usage function arglist))) + (setq origdoc (cdr usage)) (car usage))) + (help-add-fundoc-usage (concat docstring origdoc) usage)))) + +(defvar advice--docstring + ;; Can't eval-when-compile nor use defconst because it then gets pure-copied, + ;; which drops the text-properties. + ;;(eval-when-compile + (propertize "Advised function" + 'dynamic-docstring-function #'advice--make-docstring)) ;; ) + +(defun advice--make-interactive-form (function main) + ;; TODO: Make it possible to do around-like advising on the + ;; interactive forms (bug#12844). + ;; TODO: make it so that interactive spec can be a constant which + ;; dynamically checks the advice--car/cdr to do its job. + ;; TODO: Implement interactive-read-args: + ;;(when (or (commandp function) (commandp main)) + ;; `(interactive-read-args + ;; (cadr (or (interactive-form function) (interactive-form main))))) + ;; FIXME: This loads autoloaded functions too eagerly. + (cadr (or (interactive-form function) + (interactive-form main)))) + +(defsubst advice--make-1 (byte-code stack-depth function main props) + "Build a function value that adds FUNCTION to MAIN." + (let ((adv-sig (gethash main advertised-signature-table)) + (advice + (apply #'make-byte-code 128 byte-code + (vector #'apply function main props) stack-depth + advice--docstring + (when (or (commandp function) (commandp main)) + (list (advice--make-interactive-form + function main)))))) + (when adv-sig (puthash advice adv-sig advertised-signature-table)) + advice)) + +(defun advice--make (where function main props) + "Build a function value that adds FUNCTION to MAIN at WHERE. +WHERE is a symbol to select an entry in `advice--where-alist'." + (let ((desc (assq where advice--where-alist))) + (unless desc (error "Unknown add-function location `%S'" where)) + (advice--make-1 (nth 1 desc) (nth 2 desc) + function main props))) + +(defun advice--member-p (function definition) + (let ((found nil)) + (while (and (not found) (advice--p definition)) + (if (or (equal function (advice--car definition)) + (equal function (cdr (assq 'name (advice--props definition))))) + (setq found t) + (setq definition (advice--cdr definition)))) + found)) + +;;;###autoload +(defun advice--remove-function (flist function) + (if (not (advice--p flist)) + flist + (let ((first (advice--car flist)) + (props (advice--props flist))) + (if (or (equal function first) + (equal function (cdr (assq 'name props)))) + (advice--cdr flist) + (let* ((rest (advice--cdr flist)) + (nrest (advice--remove-function rest function))) + (if (eq rest nrest) flist + (advice--make-1 (aref flist 1) (aref flist 3) + first nrest props))))))) + +;;;###autoload +(defmacro add-function (where place function &optional props) + ;; TODO: + ;; - provide something like `around' for interactive forms. + ;; - provide some kind of buffer-local functionality at least when `place' + ;; is a variable. + ;; - obsolete with-wrapper-hook (mostly requires buffer-local support). + ;; - provide some kind of control over ordering. E.g. debug-on-entry, ELP + ;; and tracing want to stay first. + ;; - maybe also let `where' specify some kind of predicate and use it + ;; to implement things like mode-local or eieio-defmethod. + ;; :before is like a normal add-hook on a normal hook. + ;; :before-while is like add-hook on run-hook-with-args-until-failure. + ;; :before-until is like add-hook on run-hook-with-args-until-success. + ;; Same with :after-* but for (add-hook ... 'append). + "Add a piece of advice on the function stored at PLACE. +FUNCTION describes the code to add. WHERE describes where to add it. +WHERE can be explained by showing the resulting new function, as the +result of combining FUNCTION and the previous value of PLACE, which we +call OLDFUN here: +`:before' (lambda (&rest r) (apply FUNCTION r) (apply OLDFUN r)) +`:after' (lambda (&rest r) (prog1 (apply OLDFUN r) (apply FUNCTION r))) +`:around' (lambda (&rest r) (apply FUNCTION OLDFUN r)) +`:before-while' (lambda (&rest r) (and (apply FUNCTION r) (apply OLDFUN r))) +`:before-until' (lambda (&rest r) (or (apply FUNCTION r) (apply OLDFUN r))) +`:after-while' (lambda (&rest r) (and (apply OLDFUN r) (apply FUNCTION r))) +`:after-until' (lambda (&rest r) (or (apply OLDFUN r) (apply FUNCTION r))) +If FUNCTION was already added, do nothing. +PROPS is an alist of additional properties, among which the following have +a special meaning: +- `name': a string or symbol. It can be used to refer to this piece of advice." + (declare (debug t)) ;;(indent 2) + `(advice--add-function ,where (gv-ref ,place) ,function ,props)) + +;;;###autoload +(defun advice--add-function (where ref function props) + (unless (advice--member-p function (gv-deref ref)) + (setf (gv-deref ref) + (advice--make where function (gv-deref ref) props)))) + +(defmacro remove-function (place function) + "Remove the FUNCTION piece of advice from PLACE. +If FUNCTION was not added to PLACE, do nothing. +Instead of FUNCTION being the actual function, it can also be the `name' +of the piece of advice." + (declare (debug t)) + (gv-letplace (getter setter) place + (macroexp-let2 nil new `(advice--remove-function ,getter ,function) + `(unless (eq ,new ,getter) ,(funcall setter new))))) + +;;;; Specific application of add-function to `symbol-function' for advice. + +(defun advice--subst-main (old new) + (if (not (advice--p old)) + new + (let* ((first (advice--car old)) + (rest (advice--cdr old)) + (props (advice--props old)) + (nrest (advice--subst-main rest new))) + (if (equal rest nrest) old + (advice--make-1 (aref old 1) (aref old 3) + first nrest props))))) + +(defun advice--defalias-fset (fsetfun symbol newdef) + (let* ((olddef (if (fboundp symbol) (symbol-function symbol))) + (oldadv + (cond + ((null (get symbol 'advice--pending)) + (or olddef + (progn + (message "Delayed advice activation failed for %s: no data" + symbol) + nil))) + ((or (not olddef) (autoloadp olddef)) + (prog1 (get symbol 'advice--pending) + (put symbol 'advice--pending nil))) + (t (message "Dropping left-over advice--pending for %s" symbol) + (put symbol 'advice--pending nil) + olddef)))) + (funcall (or fsetfun #'fset) symbol (advice--subst-main oldadv newdef)))) + + +;;;###autoload +(defun advice-add (symbol where function &optional props) + "Like `add-function' but for the function named SYMBOL. +Contrary to `add-function', this will properly handle the cases where SYMBOL +is defined as a macro, alias, command, ..." + ;; TODO: + ;; - record the advice location, to display in describe-function. + ;; - change all defadvice in lisp/**/*.el. + ;; - rewrite advice.el on top of this. + ;; - obsolete advice.el. + ;; To make advice.el and nadvice.el interoperate properly I see 2 different + ;; ways: + ;; - keep them separate: complete the defalias-fset-function setter with + ;; a matching accessor which both nadvice.el and advice.el will have to use + ;; in place of symbol-function. This can probably be made to work, but + ;; they have to agree on a "protocol". + ;; - layer advice.el on top of nadvice.el. I prefer this approach. the + ;; simplest way is to make advice.el build one ad-Advice-foo function for + ;; each advised function which is advice-added/removed whenever ad-activate + ;; ad-deactivate is called. + (let ((f (and (fboundp symbol) (symbol-function symbol)))) + (cond + ((special-form-p f) + ;; Not worth the trouble trying to handle this, I think. + (error "add-advice failure: %S is a special form" symbol)) + ((and (symbolp f) + (eq 'macro (car-safe (ignore-errors (indirect-function f))))) + (let ((newval (cons 'macro (cdr (indirect-function f))))) + (put symbol 'advice--saved-rewrite (cons f newval)) + (fset symbol newval))) + ;; `f' might be a pure (hence read-only) cons! + ((and (eq 'macro (car-safe f)) (not (ignore-errors (setcdr f (cdr f)) t))) + (fset symbol (cons 'macro (cdr f)))) + )) + (let ((f (and (fboundp symbol) (symbol-function symbol)))) + (add-function where (cond + ((eq (car-safe f) 'macro) (cdr f)) + ;; If the function is not yet defined, we can't yet + ;; install the advice. + ;; FIXME: If it's an autoloaded command, we also + ;; have a problem because we need to load the + ;; command to build the interactive-form. + ((or (not f) (and (autoloadp f))) ;; (commandp f) + (get symbol 'advice--pending)) + (t (symbol-function symbol))) + function props) + (add-function :around (get symbol 'defalias-fset-function) + #'advice--defalias-fset)) + nil) + +;;;###autoload +(defun advice-remove (symbol function) + "Like `remove-function' but for the function named SYMBOL. +Contrary to `remove-function', this will work also when SYMBOL is a macro +and it will not signal an error if SYMBOL is not `fboundp'. +Instead of the actual function to remove, FUNCTION can also be the `name' +of the piece of advice." + (when (fboundp symbol) + (let ((f (symbol-function symbol))) + ;; Can't use the `if' place here, because the body is too large, + ;; resulting in use of code that only works with lexical-scoping. + (remove-function (if (eq (car-safe f) 'macro) + (cdr f) + (symbol-function symbol)) + function) + (unless (advice--p + (if (eq (car-safe f) 'macro) (cdr f) (symbol-function symbol))) + ;; Not adviced any more. + (remove-function (get symbol 'defalias-fset-function) + #'advice--defalias-fset) + (if (eq (symbol-function symbol) + (cdr (get symbol 'advice--saved-rewrite))) + (fset symbol (car (get symbol 'advice--saved-rewrite)))))) + nil)) + +;; (defun advice-mapc (fun symbol) +;; "Apply FUN to every function added as advice to SYMBOL. +;; FUN is called with a two arguments: the function that was added, and the +;; properties alist that was specified when it was added." +;; (let ((def (or (get symbol 'advice--pending) +;; (if (fboundp symbol) (symbol-function symbol))))) +;; (while (advice--p def) +;; (funcall fun (advice--car def) (advice--props def)) +;; (setq def (advice--cdr def))))) + +;;;###autoload +(defun advice-member-p (function symbol) + "Return non-nil if advice FUNCTION has been added to function SYMBOL. +Instead of FUNCTION being the actual function, it can also be the `name' +of the piece of advice." + (advice--member-p function + (or (get symbol 'advice--pending) + (if (fboundp symbol) (symbol-function symbol))))) + + +(provide 'nadvice) +;;; nadvice.el ends here === modified file 'lisp/subr.el' --- lisp/subr.el 2012-11-09 20:45:10 +0000 +++ lisp/subr.el 2012-11-12 20:43:43 +0000 @@ -2809,6 +2809,12 @@ Otherwise, return nil." (and (memq object '(nil t)) t)) +(defun special-form-p (object) + "Non-nil if and only if OBJECT is a special form." + (if (and (symbolp object) (fboundp object)) + (setq object (indirect-function object))) + (and (subrp object) (eq (cdr (subr-arity object)) 'unevalled))) + (defun field-at-pos (pos) "Return the field at position POS, taking stickiness etc into account." (let ((raw-field (get-char-property (field-beginning pos) 'field))) === modified file 'test/ChangeLog' --- test/ChangeLog 2012-10-14 07:40:05 +0000 +++ test/ChangeLog 2012-11-12 20:43:43 +0000 @@ -1,3 +1,7 @@ +2012-11-12 Stefan Monnier + + * automated/advice-tests.el: New tests. + 2012-10-14 Eli Zaretskii * automated/compile-tests.el (compile-tests--test-regexps-data): === added file 'test/automated/advice-tests.el' --- test/automated/advice-tests.el 1970-01-01 00:00:00 +0000 +++ test/automated/advice-tests.el 2012-11-12 20:43:43 +0000 @@ -0,0 +1,66 @@ +;;; advice-tests.el --- Test suite for the new advice thingy. + +;; Copyright (C) 2012 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: + +(defvar advice-tests--data + '(((defun sm-test1 (x) (+ x 4)) + (sm-test1 6) 10) + ((advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 5))) + (sm-test1 6) 50) + ((defun sm-test1 (x) (+ x 14)) + (sm-test1 6) 100) + ((null (get 'sm-test1 'defalias-fset-function)) nil) + ((advice-remove 'sm-test1 (lambda (f y) (* (funcall f y) 5))) + (sm-test1 6) 20) + ((null (get 'sm-test1 'defalias-fset-function)) t) + + ((defun sm-test2 (x) (+ x 4)) + (sm-test2 6) 10) + ((defadvice sm-test2 (around sm-test activate) + ad-do-it (setq ad-return-value (* ad-return-value 5))) + (sm-test2 6) 50) + ((ad-deactivate 'sm-test2) + (sm-test2 6) 10) + ((ad-activate 'sm-test2) + (sm-test2 6) 50) + ((defun sm-test2 (x) (+ x 14)) + (sm-test2 6) 100) + ((null (get 'sm-test2 'defalias-fset-function)) nil) + ((ad-remove-advice 'sm-test2 'around 'sm-test) + (sm-test2 6) 100) + ((ad-activate 'sm-test2) + (sm-test2 6) 20) + ((null (get 'sm-test2 'defalias-fset-function)) t) + )) + +(ert-deftest advice-tests () + "Test advice code." + (with-temp-buffer + (dolist (test advice-tests--data) + (let ((res (eval `(progn ,@(butlast test))))) + (should (equal (car (last test)) res)))))) + +;; Local Variables: +;; no-byte-compile: t +;; End: + +;;; advice-tests.el ends here. ------------------------------------------------------------ revno: 110873 committer: Dmitry Antipov branch nick: trunk timestamp: Mon 2012-11-12 20:02:46 +0400 message: * frame.h (struct frame): Convert external_tool_bar member to 1-bit unsigned bitfield. * termhooks.h (struct terminal): Remove mouse_moved member since all users are long dead. Adjust comment on mouse_position_hook. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-11-12 04:00:55 +0000 +++ src/ChangeLog 2012-11-12 16:02:46 +0000 @@ -1,5 +1,12 @@ 2012-11-12 Dmitry Antipov + * frame.h (struct frame): Convert external_tool_bar member to + 1-bit unsigned bitfield. + * termhooks.h (struct terminal): Remove mouse_moved member since + all users are long dead. Adjust comment on mouse_position_hook. + +2012-11-12 Dmitry Antipov + Simplify by using FOR_EACH_FRAME here and there. * frame.c (next_frame, prev_frame, other_visible_frames) (delete_frame, visible-frame-list): Use FOR_EACH_FRAME. === modified file 'src/frame.h' --- src/frame.h 2012-11-06 13:26:20 +0000 +++ src/frame.h 2012-11-12 16:02:46 +0000 @@ -237,7 +237,7 @@ #if defined (USE_GTK) || defined (HAVE_NS) /* Nonzero means using a tool bar that comes from the toolkit. */ - int external_tool_bar; + unsigned external_tool_bar : 1; #endif /* Margin at the top of the frame. Used to display the tool-bar. */ === modified file 'src/termhooks.h' --- src/termhooks.h 2012-11-02 09:44:08 +0000 +++ src/termhooks.h 2012-11-12 16:02:46 +0000 @@ -414,14 +414,6 @@ int memory_below_frame; /* Terminal remembers lines scrolled off bottom */ -#if 0 /* These are not used anywhere. */ - /* EMACS_INT baud_rate; */ /* Output speed in baud */ - int min_padding_speed; /* Speed below which no padding necessary. */ - int dont_calculate_costs; /* Nonzero means don't bother computing - various cost tables; we won't use them. */ -#endif - - /* Window-based redisplay interface for this device (0 for tty devices). */ struct redisplay_interface *rif; @@ -469,10 +461,7 @@ Otherwise, set *bar_window to Qnil, and *x and *y to the column and row of the character cell the mouse is over. - Set *time to the time the mouse was at the returned position. - - This should clear mouse_moved until the next motion - event arrives. */ + Set *time to the time the mouse was at the returned position. */ void (*mouse_position_hook) (struct frame **f, int, Lisp_Object *bar_window, enum scroll_bar_part *part, @@ -480,11 +469,6 @@ Lisp_Object *y, Time *); - /* The window system handling code should set this if the mouse has - moved since the last call to the mouse_position_hook. Calling that - hook should clear this. */ - int mouse_moved; - /* When a frame's focus redirection is changed, this hook tells the window system code to re-decide where to put the highlight. Under X, this means that Emacs lies about where the focus is. */ ------------------------------------------------------------ revno: 110872 committer: Vincent Belaïche branch nick: trunk timestamp: Mon 2012-11-12 06:53:53 +0100 message: * ses.texi: Doc for ses-rename-cell, ses-repair-cell-reference-all & ses-range. In all file place SES into @acronym{...}. (Advanced Features): Add key index and function index for ses-set-header-row. Add description for function ses-rename-cell. Add description for function ses-repair-cell-reference-all. (Ranges in formulas): Add description for ses-range flags. diff: === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2012-11-12 03:10:51 +0000 +++ doc/misc/ChangeLog 2012-11-12 05:53:53 +0000 @@ -1,3 +1,13 @@ +2012-11-12 Vincent Belaïche + + * ses.texi: Doc for ses-rename-cell, ses-repair-cell-reference-all & ses-range. + In all file place SES into @acronym{...}. + (Advanced Features): Add key index and function index for + ses-set-header-row. Add description for function + ses-rename-cell. Add description for function + ses-repair-cell-reference-all. + (Ranges in formulas): Add description for ses-range flags. + 2012-11-12 Paul Eggert * texinfo.tex: Merge from gnulib. === modified file 'doc/misc/ses.texi' --- doc/misc/ses.texi 2012-07-25 05:48:19 +0000 +++ doc/misc/ses.texi 2012-11-12 05:53:53 +0000 @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @c %**start of header @setfilename ../../info/ses -@settitle SES: Simple Emacs Spreadsheet +@settitle @acronym{SES}: Simple Emacs Spreadsheet @setchapternewpage off @syncodeindex fn cp @syncodeindex vr cp @@ -9,7 +9,7 @@ @c %**end of header @copying -This file documents SES: the Simple Emacs Spreadsheet. +This file documents @acronym{SES}: the Simple Emacs Spreadsheet. Copyright @copyright{} 2002-2012 Free Software Foundation, Inc. @@ -29,13 +29,13 @@ @dircategory Emacs misc features @direntry -* SES: (ses). Simple Emacs Spreadsheet. +* @acronym{SES}: (ses). Simple Emacs Spreadsheet. @end direntry @finalout @titlepage -@title SES +@title @acronym{SES} @subtitle Simple Emacs Spreadsheet @author Jonathan A. Yavner @author @email{jyavner@@member.fsf.org} @@ -52,10 +52,10 @@ @ifnottex @node Top, Sales Pitch, (dir), (dir) @comment node-name, next, previous, up -@top SES: Simple Emacs Spreadsheet +@top @acronym{SES}: Simple Emacs Spreadsheet @display -SES is a major mode for GNU Emacs to edit spreadsheet files, which +@acronym{SES} is a major mode for GNU Emacs to edit spreadsheet files, which contain a rectangular grid of cells. The cells' values are specified by formulas that can refer to the values of other cells. @end display @@ -66,7 +66,7 @@ @insertcopying @menu -* Sales Pitch:: Why use SES? +* Sales Pitch:: Why use @acronym{SES}? * The Basics:: Basic spreadsheet commands * Advanced Features:: Want to know more? * For Gurus:: Want to know @emph{even more}? @@ -126,9 +126,9 @@ Point is always at the left edge of a cell, or at the empty endline. When mark is inactive, the current cell is underlined. When mark is -active, the range is the highlighted rectangle of cells (SES always +active, the range is the highlighted rectangle of cells (@acronym{SES} always uses transient mark mode). Drag the mouse from A1 to A3 to create the -range A1-A2. Many SES commands operate only on single cells, not +range A1-A2. Many @acronym{SES} commands operate only on single cells, not ranges. @table @kbd @@ -155,7 +155,7 @@ * Printer functions:: * Clearing cells:: * Copy/cut/paste:: -* Customizing SES:: +* Customizing @acronym{SES}:: @end menu @node Formulas, Resizing, The Basics, The Basics @@ -192,7 +192,7 @@ expression, you can use @kbd{M-@key{TAB}} to complete symbol names. @item ' @r{(apostrophe)} -Enter a symbol (ses-read-symbol). SES remembers all symbols that have +Enter a symbol (ses-read-symbol). @acronym{SES} remembers all symbols that have been used as formulas, so you can type just the beginning of a symbol and use @kbd{@key{SPC}}, @kbd{@key{TAB}}, and @kbd{?} to complete it. @end table @@ -349,7 +349,7 @@ @end table -@node Copy/cut/paste, Customizing SES, Clearing cells, The Basics +@node Copy/cut/paste, Customizing @acronym{SES}, Clearing cells, The Basics @section Copy, cut, and paste @cindex copy @cindex cut @@ -365,7 +365,7 @@ @findex ses-yank-pop The copy functions work on rectangular regions of cells. You can paste the -copies into non-SES buffers to export the print text. +copies into non-@acronym{SES} buffers to export the print text. @table @kbd @item M-w @@ -394,7 +394,7 @@ differently depending on the format of the text being inserted: @itemize @bullet @item -When pasting cells that were cut from a SES buffer, the print text is +When pasting cells that were cut from a @acronym{SES} buffer, the print text is ignored and only the attached formula and printer are inserted; cell references in the formula are relocated unless you use @kbd{C-u}. @item @@ -402,7 +402,7 @@ is the current cell. If part of the rectangle is beyond the edges of the spreadsheet, you must confirm the increase in spreadsheet size. @item -Non-SES text is usually inserted as a replacement formula for the +Non-@acronym{SES} text is usually inserted as a replacement formula for the current cell. If the formula would be a symbol, it's treated as a string unless you use @kbd{C-u}. Pasted formulas with syntax errors are always treated as strings. @@ -420,12 +420,12 @@ @item M-y Immediately after a paste, you can replace the text with a preceding element from the kill ring (@code{ses-yank-pop}). Unlike the standard -Emacs yank-pop, the SES version uses @code{undo} to delete the old +Emacs yank-pop, the @acronym{SES} version uses @code{undo} to delete the old yank. This doesn't make any difference? @end table -@node Customizing SES, , Copy/cut/paste, The Basics -@section Customizing SES +@node Customizing @acronym{SES}, , Copy/cut/paste, The Basics +@section Customizing @acronym{SES} @cindex customizing @vindex enable-local-eval @vindex ses-mode-hook @@ -443,7 +443,7 @@ list. @code{ses-mode-hook} is a normal mode hook (list of functions to -execute when starting SES mode for a buffer). +execute when starting @acronym{SES} mode for a buffer). The variable @code{safe-functions} is a list of possibly-unsafe functions to be treated as safe when analyzing formulas and printers. @@ -469,7 +469,10 @@ @table @kbd @item C-c M-C-h -(@code{ses-set-header-row}). The header line at the top of the SES +(@code{ses-set-header-row}). +@findex ses-set-header-row +@kindex C-c M-C-h +The header line at the top of the @acronym{SES} window normally shows the column letter for each column. You can set it to show a copy of some row, such as a row of column titles, so that row will always be visible. Default is to set the current row as the @@ -478,6 +481,16 @@ @item [header-line mouse-3] Pops up a menu to set the current row as the header, or revert to column letters. +@item M-x ses-rename-cell +@findex ses-rename-cell +Rename a cell from a standard A1-like name to any +string. +@item M-x ses-repair-cell-reference-all +@findex ses-repair-cell-reference-all +When you interrupt a cell formula update by clicking @kbd{C-g}, then +the cell reference link may be broken, which will jeopardize automatic +cell update when any other cell on which it depends is changed. To +repair that use function @code{ses-repair-cell-reference-all} @end table @menu @@ -498,9 +511,9 @@ @findex ses-renarrow-buffer @findex ses-reprint-all -A SES file consists of a print area and a data area. Normally the +A @acronym{SES} file consists of a print area and a data area. Normally the buffer is narrowed to show only the print area. The print area is -read-only except for special SES commands; it contains cell values +read-only except for special @acronym{SES} commands; it contains cell values formatted by printer functions. The data area records the formula and printer functions, etc. @@ -576,6 +589,52 @@ a new column just beyond a one-row range, the new cell is included in the range. New cells inserted just before a range are not included. +Flags can be added to @code{ses-range} immediately after the @var{to} +cell. +@table @code +@item ! +Empty cells in range can be removed by adding the @code{!} flag. An +empty cell is a cell the value of which is one of symbols @code{nil} +or @code{*skip*}. For instance @code{(ses-range A1 A4 !)} will do the +same as @code{(list A1 A3)} when cells @code{A2} and @code{A4} are +empty. +@item _ +Empty cell values are replaced by the argument following flag +@code{_}, or @code{0} when flag @code{_} is last in argument list. For +instance @code{(ses-range A1 A4 _ "empty")} will do the same as +@code{(list A1 "empty" A3 "empty")} when cells @code{A2} and @code{A4} +are empty. Similarly, @code{(ses-range A1 A4 _ )} will do the same as +@code{(list A1 0 A3 0)}. +@item >v +When order matters, list cells by reading cells rowwise from top left +to bottom right. This flag is provided for completeness only as it is +the default reading order. +@item +List cells by reading cells columnwise from top left to bottom right. +@item v< +List cells by reading cells columnwise from top right to bottom left. +@item v +A short hand for @code{v>}. +@item ^ +A short hand for @code{^>}. +@item > +A short hand for @code{>v}. +@item < +A short hand for @code{>^}. +@item * +Instead of listing cells, it makes a Calc vector or matrix of it +(@pxref{Top,,,calc,GNU Emacs Calc Manual}). If the range contains only +one row or one column a vector is made, otherwise a matrix is made. +@item *2 +Same as @code{*} except that a matrix is always made even when there +is only one row or column in the range. +@item *1 +Same as @code{*} except that a vector is always made even when there +is only one row or column in the range, that is to say the +corresponding matrix is flattened. +@end table @node Sorting by column, Standard formula functions, Ranges in formulas, Advanced Features @section Sorting by column @@ -653,7 +712,7 @@ row or the next non-@code{nil} cell), the result is truncated if the cell's value is a string, or replaced with hash marks otherwise. -SES could get confused by printer results that contain newlines or +@acronym{SES} could get confused by printer results that contain newlines or tabs, so these are replaced with question marks. @table @kbd @@ -734,7 +793,7 @@ A common organization for spreadsheets is to have a bunch of ``detail'' rows, each perhaps describing a transaction, and then a set of ``summary'' rows that each show reduced data for some subset of the -details. SES supports this organization via the @code{ses-select} +details. @acronym{SES} supports this organization via the @code{ses-select} function. @table @code @@ -771,7 +830,7 @@ * Nonrelocatable references:: * The data area:: * Buffer-local variables in spreadsheets:: -* Uses of defadvice in SES:: +* Uses of defadvice in @acronym{SES}:: @end menu @node Deferred updates, Nonrelocatable references, For Gurus, For Gurus @@ -799,7 +858,7 @@ These deferred cell-writes cannot be interrupted by @kbd{C-g}, so you'll just have to wait. -SES uses @code{run-with-idle-timer} to move the cell underline when +@acronym{SES} uses @code{run-with-idle-timer} to move the cell underline when Emacs will be scrolling the buffer after the end of a command, and also to narrow and underline after @kbd{C-x C-v}. This is visible as a momentary glitch after C-x C-v and certain scrolling commands. You @@ -843,14 +902,14 @@ macros for each row, followed by column-widths, column-printers, default-printer, and header-row. Then there's the global parameters (file-format ID, numrows, numcols) and the local variables (specifying -SES mode for the buffer, etc.) +@acronym{SES} mode for the buffer, etc.) -When a SES file is loaded, first the numrows and numcols values are +When a @acronym{SES} file is loaded, first the numrows and numcols values are loaded, then the entire data area is @code{eval}ed, and finally the local variables are processed. You can edit the data area, but don't insert or delete any newlines -except in the local-variables part, since SES locates things by +except in the local-variables part, since @acronym{SES} locates things by counting newlines. Use @kbd{C-x C-e} at the end of a line to install your edits into the spreadsheet data structures (this does not update the print area, use e.g. @kbd{C-c C-l} for that). @@ -866,7 +925,7 @@ @end table -@node Buffer-local variables in spreadsheets, Uses of defadvice in SES, The data area, For Gurus +@node Buffer-local variables in spreadsheets, Uses of defadvice in @acronym{SES}, The data area, For Gurus @section Buffer-local variables in spreadsheets @cindex buffer-local variables @cindex variables, buffer-local @@ -900,8 +959,8 @@ (put 'your-function-name 'safe-function t) @end lisp -@node Uses of defadvice in SES, , Buffer-local variables in spreadsheets, For Gurus -@section Uses of defadvice in SES +@node Uses of defadvice in @acronym{SES}, , Buffer-local variables in spreadsheets, For Gurus +@section Uses of defadvice in @acronym{SES} @cindex defadvice @cindex undo-more @cindex copy-region-as-kill ------------------------------------------------------------ Use --include-merged or -n0 to see merged revisions.