diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 3df05a7a37a..11666c60c74 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,44 @@ +2013-04-17 Fabián Ezequiel Gallina + + New defun movement commands. + * progmodes/python.el (python-nav--syntactically) + (python-nav--forward-defun, python-nav-backward-defun) + (python-nav-forward-defun): New functions. + +2013-04-17 Fabián Ezequiel Gallina + + * progmodes/python.el (python-syntax--context-compiler-macro): New defun. + (python-syntax-context): Use named compiler-macro for backwards + compatibility with Emacs 24.x. + +2013-04-17 Leo Liu + + * progmodes/octave-mod.el (octave-mode-map): Fix key binding to + octave-hide-process-buffer. + +2013-04-17 Stefan Monnier + + * vc/vc-hg.el (vc-hg-annotate-re): Disallow ": " in file names + (bug#14216). + +2013-04-17 Jean-Philippe Gravel + + * progmodes/gdb-mi.el (gdbmi-bnf-incomplete-record-result): + Fix adjustment of offset when receiving incomplete responses from GDB + (bug#14129). + +2013-04-16 Stefan Monnier + + * progmodes/python.el (python-mode-skeleton-abbrev-table): Rename from + python-mode-abbrev-table. + (python-skeleton-define): Adjust accordingly. + (python-mode-abbrev-table): New table that inherits from it so that + python-skeleton-autoinsert does not affect non-skeleton abbrevs. + + * abbrev.el (abbrev--symbol): New function, extracted from abbrev-symbol. + (abbrev-symbol): Use it. + (abbrev--before-point): Use it since we already handle inheritance. + 2013-04-16 Leo Liu * progmodes/octave-mod.el (octave-mode-map): Remove redundant key diff --git a/lisp/abbrev.el b/lisp/abbrev.el index bd09653103f..cc7ebe489f7 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -669,6 +669,26 @@ either a single abbrev table or a list of abbrev tables." tables)))) +(defun abbrev--symbol (abbrev table) + "Return the symbol representing abbrev named ABBREV in TABLE. +This symbol's name is ABBREV, but it is not the canonical symbol of that name; +it is interned in the abbrev-table TABLE rather than the normal obarray. +The value is nil if that abbrev is not defined." + (let* ((case-fold (not (abbrev-table-get table :case-fixed))) + ;; In case the table doesn't set :case-fixed but some of the + ;; abbrevs do, we have to be careful. + (sym + ;; First try without case-folding. + (or (intern-soft abbrev table) + (when case-fold + ;; We didn't find any abbrev, try case-folding. + (let ((sym (intern-soft (downcase abbrev) table))) + ;; Only use it if it doesn't require :case-fixed. + (and sym (not (abbrev-get sym :case-fixed)) + sym)))))) + (if (symbol-value sym) + sym))) + (defun abbrev-symbol (abbrev &optional table) "Return the symbol representing abbrev named ABBREV. This symbol's name is ABBREV, but it is not the canonical symbol of that name; @@ -678,23 +698,11 @@ Optional second arg TABLE is abbrev table to look it up in. The default is to try buffer's mode-specific abbrev table, then global table." (let ((tables (abbrev--active-tables table)) sym) - (while (and tables (not (symbol-value sym))) - (let* ((table (pop tables)) - (case-fold (not (abbrev-table-get table :case-fixed)))) + (while (and tables (not sym)) + (let* ((table (pop tables))) (setq tables (append (abbrev-table-get table :parents) tables)) - ;; In case the table doesn't set :case-fixed but some of the - ;; abbrevs do, we have to be careful. - (setq sym - ;; First try without case-folding. - (or (intern-soft abbrev table) - (when case-fold - ;; We didn't find any abbrev, try case-folding. - (let ((sym (intern-soft (downcase abbrev) table))) - ;; Only use it if it doesn't require :case-fixed. - (and sym (not (abbrev-get sym :case-fixed)) - sym))))))) - (if (symbol-value sym) - sym))) + (setq sym (abbrev--symbol abbrev table)))) + sym)) (defun abbrev-expansion (abbrev &optional table) @@ -748,7 +756,7 @@ then ABBREV is looked up in that table only." (setq start (match-beginning 1)) (setq end (match-end 1))))) (setq name (buffer-substring start end)) - (let ((abbrev (abbrev-symbol name table))) + (let ((abbrev (abbrev--symbol name table))) (when abbrev (setq enable-fun (abbrev-get abbrev :enable-function)) (and (or (not enable-fun) (funcall enable-fun)) diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 8ba2822c3a3..f5e1abdd546 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -2149,19 +2149,23 @@ the end of the current result or async record is reached." ;; Search the data stream for the end of the current record: (let* ((newline-pos (string-match "\n" gud-marker-acc gdbmi-bnf-offset)) (is-progressive (equal (cdr class-command) 'progressive)) - (is-complete (not (null newline-pos))) - result-str) + (is-complete (not (null newline-pos))) + result-str) + + (when gdbmi-debug-mode + (message "gdbmi-bnf-incomplete-record-result: %s" + (substring gud-marker-acc gdbmi-bnf-offset newline-pos))) ;; Update the gdbmi-bnf-offset only if the current chunk of data can ;; be processed by the class-command handler: (when (or is-complete is-progressive) - (setq result-str + (setq result-str (substring gud-marker-acc gdbmi-bnf-offset newline-pos)) - (setq gdbmi-bnf-offset (+ 1 newline-pos))) - (if gdbmi-debug-mode - (message "gdbmi-bnf-incomplete-record-result: %s" - (substring gud-marker-acc gdbmi-bnf-offset newline-pos))) + ;; Move gdbmi-bnf-offset past the end of the chunk. + (setq gdbmi-bnf-offset (+ gdbmi-bnf-offset (length result-str))) + (when newline-pos + (setq gdbmi-bnf-offset (1+ gdbmi-bnf-offset)))) ;; Update the parsing state before invoking the handler in class-command ;; to make sure it's not left in an invalid state if the handler was diff --git a/lisp/progmodes/octave-mod.el b/lisp/progmodes/octave-mod.el index 4f70cf77b76..4683186e603 100644 --- a/lisp/progmodes/octave-mod.el +++ b/lisp/progmodes/octave-mod.el @@ -228,15 +228,14 @@ parenthetical grouping.") (define-key map "\C-c\C-if" 'octave-send-defun) (define-key map "\C-c\C-ir" 'octave-send-region) (define-key map "\C-c\C-is" 'octave-show-process-buffer) - (define-key map "\C-c\C-ih" 'octave-hide-process-buffer) + (define-key map "\C-c\C-iq" 'octave-hide-process-buffer) (define-key map "\C-c\C-ik" 'octave-kill-process) (define-key map "\C-c\C-i\C-l" 'octave-send-line) (define-key map "\C-c\C-i\C-b" 'octave-send-block) (define-key map "\C-c\C-i\C-f" 'octave-send-defun) (define-key map "\C-c\C-i\C-r" 'octave-send-region) (define-key map "\C-c\C-i\C-s" 'octave-show-process-buffer) - ;; FIXME: free C-h so it can do the describe-prefix-bindings. - (define-key map "\C-c\C-i\C-h" 'octave-hide-process-buffer) + (define-key map "\C-c\C-i\C-q" 'octave-hide-process-buffer) (define-key map "\C-c\C-i\C-k" 'octave-kill-process) map) "Keymap used in Octave mode.") diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index d1009534e49..1d7cf02ca5a 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -368,22 +368,24 @@ This variant of `rx' supports common python named REGEXPS." ;;; Font-lock and syntax +(eval-when-compile + (defun python-syntax--context-compiler-macro (form type &optional syntax-ppss) + (pcase type + (`'comment + `(let ((ppss (or ,syntax-ppss (syntax-ppss)))) + (and (nth 4 ppss) (nth 8 ppss)))) + (`'string + `(let ((ppss (or ,syntax-ppss (syntax-ppss)))) + (and (nth 3 ppss) (nth 8 ppss)))) + (`'paren + `(nth 1 (or ,syntax-ppss (syntax-ppss)))) + (_ form)))) + (defun python-syntax-context (type &optional syntax-ppss) "Return non-nil if point is on TYPE using SYNTAX-PPSS. TYPE can be `comment', `string' or `paren'. It returns the start character address of the specified TYPE." - (declare (compiler-macro - (lambda (form) - (pcase type - (`'comment - `(let ((ppss (or ,syntax-ppss (syntax-ppss)))) - (and (nth 4 ppss) (nth 8 ppss)))) - (`'string - `(let ((ppss (or ,syntax-ppss (syntax-ppss)))) - (and (nth 3 ppss) (nth 8 ppss)))) - (`'paren - `(nth 1 (or ,syntax-ppss (syntax-ppss)))) - (_ form))))) + (declare (compiler-macro python-syntax--context-compiler-macro)) (let ((ppss (or syntax-ppss (syntax-ppss)))) (pcase type (`comment (and (nth 4 ppss) (nth 8 ppss))) @@ -1190,6 +1192,66 @@ Returns nil if point is not in a def or class." ;; Ensure point moves forward. (and (> beg-pos (point)) (goto-char beg-pos))))) +(defun python-nav--syntactically (fn poscompfn &optional pos) + "Move to point using FN ignoring non-code or paren context. +FN must take no arguments and could be used to set match-data. +POSCOMPFN is a two arguments function used to compare current and +previous point after it is moved using FN, this is normally a +less-than or greater-than comparison. Optional argument POS is +internally used in recursive calls and should not be explicitly +passed." + (let* ((newpos + (and (funcall fn) + (save-match-data + (and + (not (python-syntax-context-type)) + (point-marker))))) + (current-match-data (match-data))) + (cond ((or (and (not pos) newpos) + (and pos newpos (funcall poscompfn newpos pos))) + (set-match-data current-match-data) + (point-marker)) + ((and (not pos) (not newpos)) nil) + (t (python-nav--syntactically + fn poscompfn (point-marker)))))) + +(defun python-nav--forward-defun (arg) + "Internal implementation of python-nav-{backward,forward}-defun. +Uses ARG to define which function to call, and how many times +repeat it." + (let ((found)) + (while (and (> arg 0) + (setq found + (python-nav--syntactically + (lambda () + (re-search-forward + python-nav-beginning-of-defun-regexp nil t)) + '>))) + (setq arg (1- arg))) + (while (and (< arg 0) + (setq found + (python-nav--syntactically + (lambda () + (re-search-backward + python-nav-beginning-of-defun-regexp nil t)) + '<))) + (setq arg (1+ arg))) + found)) + +(defun python-nav-backward-defun (&optional arg) + "Navigate to closer defun backward ARG times. +Unlikely `python-nav-beginning-of-defun' this doesn't care about +nested definitions." + (interactive "^p") + (python-nav--forward-defun (- (or arg 1)))) + +(defun python-nav-forward-defun (&optional arg) + "Navigate to closer defun forward ARG times. +Unlikely `python-nav-beginning-of-defun' this doesn't care about +nested definitions." + (interactive "^p") + (python-nav--forward-defun (or arg 1))) + (defun python-nav-beginning-of-statement () "Move to start of current statement." (interactive "^") @@ -2654,8 +2716,8 @@ the if condition." (defvar python-skeleton-available '() "Internal list of available skeletons.") -(define-abbrev-table 'python-mode-abbrev-table () - "Abbrev table for Python mode." +(define-abbrev-table 'python-mode-skeleton-abbrev-table () + "Abbrev table for Python mode skeletons." :case-fixed t ;; Allow / inside abbrevs. :regexp "\\(?:^\\|[^/]\\)\\<\\([[:word:]/]+\\)\\W*" @@ -2668,13 +2730,13 @@ the if condition." (defmacro python-skeleton-define (name doc &rest skel) "Define a `python-mode' skeleton using NAME DOC and SKEL. The skeleton will be bound to python-skeleton-NAME and will -be added to `python-mode-abbrev-table'." +be added to `python-mode-skeleton-abbrev-table'." (declare (indent 2)) (let* ((name (symbol-name name)) (function-name (intern (concat "python-skeleton-" name)))) `(progn - (define-abbrev python-mode-abbrev-table ,name "" ',function-name - :system t) + (define-abbrev python-mode-skeleton-abbrev-table + ,name "" ',function-name :system t) (setq python-skeleton-available (cons ',function-name python-skeleton-available)) (define-skeleton ,function-name @@ -2682,6 +2744,10 @@ be added to `python-mode-abbrev-table'." (format "Insert %s statement." name)) ,@skel)))) +(define-abbrev-table 'python-mode-abbrev-table () + "Abbrev table for Python mode." + :parents (list python-mode-skeleton-abbrev-table)) + (defmacro python-define-auxiliary-skeleton (name doc &optional &rest skel) "Define a `python-mode' auxiliary skeleton using NAME DOC and SKEL. The skeleton will be bound to python-skeleton-NAME." diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index f39ef568e8b..033e78c20cd 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -357,7 +357,7 @@ Optional arg REVISION is a revision to annotate from." ;;215 Wed Jun 20 21:22:58 2007 -0700 foo.c: CONTENTS ;; i.e. VERSION_NUMBER DATE FILENAME: CONTENTS (defconst vc-hg-annotate-re - "^[ \t]*\\([0-9]+\\) \\(.\\{30\\}\\)\\(?:\\(: \\)\\|\\(?: +\\(.+\\): \\)\\)") + "^[ \t]*\\([0-9]+\\) \\(.\\{30\\}\\)\\(?:\\(: \\)\\|\\(?: +\\([^:\n]+\\(?::\\(?:[^: \n][^:\n]*\\)?\\)*\\): \\)\\)") (defun vc-hg-annotate-time () (when (looking-at vc-hg-annotate-re) diff --git a/test/ChangeLog b/test/ChangeLog index bf68984e9e8..7c25ad1a804 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,8 @@ +2013-04-17 Fabián Ezequiel Gallina + + * automated/python-tests.el (python-nav-backward-defun-1) + (python-nav-forward-defun-1): New tests. + 2013-04-09 Masatake YAMATO * automated/add-log-tests.el: New file. (Bug#14112) diff --git a/test/automated/python-tests.el b/test/automated/python-tests.el index 1a741b45d81..a7c7aab6464 100644 --- a/test/automated/python-tests.el +++ b/test/automated/python-tests.el @@ -674,6 +674,93 @@ def decoratorFunctionWithArguments(arg1, arg2, arg3): (python-tests-look-at "return wrapped_f") (line-beginning-position)))))) +(ert-deftest python-nav-backward-defun-1 () + (python-tests-with-temp-buffer + " +class A(object): # A + + def a(self): # a + pass + + def b(self): # b + pass + + class B(object): # B + + class C(object): # C + + def d(self): # d + pass + + # def e(self): # e + # pass + + def c(self): # c + pass + + # def d(self): # d + # pass +" + (goto-char (point-max)) + (should (= (save-excursion (python-nav-backward-defun)) + (python-tests-look-at " def c(self): # c" -1))) + (should (= (save-excursion (python-nav-backward-defun)) + (python-tests-look-at " def d(self): # d" -1))) + (should (= (save-excursion (python-nav-backward-defun)) + (python-tests-look-at " class C(object): # C" -1))) + (should (= (save-excursion (python-nav-backward-defun)) + (python-tests-look-at " class B(object): # B" -1))) + (should (= (save-excursion (python-nav-backward-defun)) + (python-tests-look-at " def b(self): # b" -1))) + (should (= (save-excursion (python-nav-backward-defun)) + (python-tests-look-at " def a(self): # a" -1))) + (should (= (save-excursion (python-nav-backward-defun)) + (python-tests-look-at "class A(object): # A" -1))) + (should (not (python-nav-backward-defun))))) + +(ert-deftest python-nav-forward-defun-1 () + (python-tests-with-temp-buffer + " +class A(object): # A + + def a(self): # a + pass + + def b(self): # b + pass + + class B(object): # B + + class C(object): # C + + def d(self): # d + pass + + # def e(self): # e + # pass + + def c(self): # c + pass + + # def d(self): # d + # pass +" + (goto-char (point-min)) + (should (= (save-excursion (python-nav-forward-defun)) + (python-tests-look-at "(object): # A"))) + (should (= (save-excursion (python-nav-forward-defun)) + (python-tests-look-at "(self): # a"))) + (should (= (save-excursion (python-nav-forward-defun)) + (python-tests-look-at "(self): # b"))) + (should (= (save-excursion (python-nav-forward-defun)) + (python-tests-look-at "(object): # B"))) + (should (= (save-excursion (python-nav-forward-defun)) + (python-tests-look-at "(object): # C"))) + (should (= (save-excursion (python-nav-forward-defun)) + (python-tests-look-at "(self): # d"))) + (should (= (save-excursion (python-nav-forward-defun)) + (python-tests-look-at "(self): # c"))) + (should (not (python-nav-forward-defun))))) (ert-deftest python-nav-beginning-of-statement-1 () (python-tests-with-temp-buffer