Re: [acm@muc.de: Re: Emacs 22.2 release plans - request for a slight delay.]

[Alan Mackenzie <acm@muc.de>]

Guten Mitternacht, Martin!

On Mon, Mar 17, 2008 at 10:30:35AM +0100, martin rudalics wrote:
> > Guten Morgen, Martin!

> Good morning, Alan!

> > I think the answer to this is to write the following in cc-cmds.el:

> >     (defun c-defun-name (&optional pos)
> >       "Return the name of the current function, or the one at POS.

[ .... ]

> That would be fine, indeed.  Although `c-top-level-object-name' would
> be sooo much better ;-)

Maybe.  The point is, only the subset of "top-level-object"s which have
brace-blocks is meant.

Anyhow, here's a first shot at the patch.  I won't say that it works,
merely that it has worked, and at a reasonable speed, even at the end of
..../src/lisp.h.

Does anybody know anybody on a C++ or Objective C project, who could test
out these bits?

Anyhow, please try out this patch; it's based on the Emacs-22 branch:





Index: progmodes/cc-cmds.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/progmodes/cc-cmds.el,v
retrieving revision 1.62.2.3
diff -c -r1.62.2.3 cc-cmds.el
*** progmodes/cc-cmds.el	26 Jan 2008 22:26:18 -0000	1.62.2.3
--- progmodes/cc-cmds.el	25 Mar 2008 22:59:15 -0000
***************
*** 1679,1684 ****
--- 1679,1751 ----
      (c-keep-region-active)
      (= arg 0)))
  
+ ;;;; FIXME!!!  The following is not fully worked out, 2008-03-23
+ (defun c-defun-name ()
+   "Return the name of the current defun, or NIL if there isn't one.
+ \"Defun\" here means a function, or other top level construct
+ with a brace block."
+   (interactive)
+   (c-save-buffer-state
+       (beginning-of-defun-function end-of-defun-function
+        where pos name-end)
+  
+     (save-excursion
+       ;; Move back out of any macro/comment/string we happen to be in.
+       (c-beginning-of-macro)
+       (setq pos (c-literal-limits))
+       (if pos (goto-char (car pos)))
+ 
+       (setq where (c-where-wrt-brace-construct))
+ 
+       ;; Move to the beginning of the current defun, if any, if we're not
+       ;; already there.
+       (if (eq where 'outwith-function)
+ 	  nil
+ 	(unless (eq where 'at-header)
+ 	  (c-backward-to-nth-BOF-{ 1 where)
+ 	  (c-beginning-of-decl-1))
+ 
+ 	;; Pick out the defun name, according to the type of defun.
+ 	(cond
+ 	 ((and (looking-at c-type-prefix-key)
+ 	       (progn (c-forward-token-2 2) ; over "struct foo "
+ 		      (eq (char-after) ?\{)))
+ 	  ;; struct, union, enum, or similar:
+ 	  (c-backward-syntactic-ws)
+ 	  (setq name-end (point))
+ 	  (buffer-substring-no-properties
+ 	   (progn
+ 	     (c-backward-token-2 2)
+ 	     (point))
+ 	   name-end))
+ 
+ 	 ((looking-at "DEFUN\\_>")
+ 	  ;; DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory, ...) ==> Ffile_name_directory
+ 	  ;; DEFUN(POSIX::STREAM-LOCK, stream lockp &key BLOCK SHARED START LENGTH) ==> POSIX::STREAM-LOCK	  
+ 	  (down-list 1)
+ 	  (c-forward-syntactic-ws)
+ 	  (when (eq (char-after) ?\")
+ 	    (forward-sexp 1)
+ 	    (c-forward-token-2))	; over the comma and following WS.
+ 	  (buffer-substring-no-properties
+ 	   (point)
+ 	   (progn
+ 	     (c-forward-token-2)
+ 	     (c-backward-syntactic-ws)
+ 	     (point))))
+ 		
+ 	 (t
+ 	 ;; Normal function or initializer.
+ 	  (when (c-syntactic-re-search-forward "[{(]" nil t)
+ 	    (backward-char)
+ 	    (c-backward-syntactic-ws)
+ 	    (when (eq (char-before) ?\=) ; struct foo bar = {0, 0} ;
+ 	      (c-backward-token-2)
+ 	      (c-backward-syntactic-ws))
+ 	    (setq name-end (point))
+ 	    (c-backward-token-2)
+ 	    (buffer-substring-no-properties (point) name-end))))))))
+ 
  (defun c-declaration-limits (near)
    ;; Return a cons of the beginning and end positions of the current
    ;; top level declaration or macro.  If point is not inside any then
***************
*** 1810,1815 ****
--- 1877,1891 ----
        (goto-char (car decl-limits))
        (push-mark (cdr decl-limits) nil t))))
  
+ (defun c-cpp-define-name ()
+   "Return the name of the current CPP macro, or NIL if we're not in one."
+   (interactive)
+   (save-excursion
+     (and c-opt-cpp-macro-define-start
+ 	 (c-beginning-of-macro)
+ 	 (looking-at c-opt-cpp-macro-define-start)
+ 	 (match-string-no-properties 1))))
+ 
  \f
  ;; Movement by statements.
  (defun c-in-comment-line-prefix-p ()
Index: progmodes/cc-langs.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/progmodes/cc-langs.el,v
retrieving revision 1.47.2.9
diff -c -r1.47.2.9 cc-langs.el
*** progmodes/cc-langs.el	1 Mar 2008 08:52:25 -0000	1.47.2.9
--- progmodes/cc-langs.el	25 Mar 2008 22:59:17 -0000
***************
*** 728,740 ****
  	"define"))
  
  (c-lang-defconst c-opt-cpp-macro-define-start
!   ;; Regexp matching everything up to the macro body of a cpp define,
!   ;; or the end of the logical line if there is none.  Set if
!   ;; c-opt-cpp-macro-define is.
    t (if (c-lang-const c-opt-cpp-macro-define)
  	(concat (c-lang-const c-opt-cpp-prefix)
  		(c-lang-const c-opt-cpp-macro-define)
! 		"[ \t]+\\(\\sw\\|_\\)+\\(\([^\)]*\)\\)?"
  		"\\([ \t]\\|\\\\\n\\)*")))
  (c-lang-defvar c-opt-cpp-macro-define-start
    (c-lang-const c-opt-cpp-macro-define-start))
--- 728,741 ----
  	"define"))
  
  (c-lang-defconst c-opt-cpp-macro-define-start
!   ;; Regexp matching everything up to the macro body of a cpp define, or the
!   ;; end of the logical line if there is none.  Submatch 1 is the name of the
!   ;; macro.  Set if c-opt-cpp-macro-define is.
    t (if (c-lang-const c-opt-cpp-macro-define)
  	(concat (c-lang-const c-opt-cpp-prefix)
  		(c-lang-const c-opt-cpp-macro-define)
! 		"[ \t]+\\(\\(\\sw\\|_\\)+\\)\\(\([^\)]*\)\\)?"
! 		;;       ^                 ^ #defined name
  		"\\([ \t]\\|\\\\\n\\)*")))
  (c-lang-defvar c-opt-cpp-macro-define-start
    (c-lang-const c-opt-cpp-macro-define-start))
Index: add-log.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/add-log.el,v
retrieving revision 1.184.2.5
diff -c -r1.184.2.5 add-log.el
*** add-log.el	7 Jan 2008 02:45:06 -0000	1.184.2.5
--- add-log.el	25 Mar 2008 22:59:18 -0000
***************
*** 798,963 ****
  		   (buffer-substring-no-properties (point)
  						   (progn (forward-sexp 1)
  							  (point)))))
- 		((and (memq major-mode add-log-c-like-modes)
- 		      (save-excursion
- 			(beginning-of-line)
- 			;; Use eq instead of = here to avoid
- 			;; error when at bob and char-after
- 			;; returns nil.
- 			(while (eq (char-after (- (point) 2)) ?\\)
- 			  (forward-line -1))
- 			(looking-at "[ \t]*#[ \t]*define[ \t]")))
- 		 ;; Handle a C macro definition.
- 		 (beginning-of-line)
- 		 (while (eq (char-after (- (point) 2)) ?\\) ;not =; note above
- 		   (forward-line -1))
- 		 (search-forward "define")
- 		 (skip-chars-forward " \t")
- 		 (buffer-substring-no-properties (point)
- 						 (progn (forward-sexp 1)
- 							(point))))
  		((memq major-mode add-log-c-like-modes)
! 		 ;; See whether the point is inside a defun.
! 		 (let (having-previous-defun
! 		       having-next-defun
! 		       previous-defun-end
! 		       next-defun-beginning)
! 		     
! 		   (save-excursion
! 		     (setq having-previous-defun
! 			   (c-beginning-of-defun))
! 		     (c-end-of-defun)
! 		     ;; `c-end-of-defun' moves point to the line after
! 		     ;; the function close, but the position we prefer
! 		     ;; here is the position after the final }.
! 		     (backward-sexp 1)
! 		     (forward-sexp 1)
!                      ;; Skip the semicolon ``;'' for
! 		     ;; enum/union/struct/class definition.
! 		     (if (= (char-after (point)) ?\;)
! 			 (forward-char 1))
! 		     (setq previous-defun-end (point)))
! 
! 		   (save-excursion
! 		     (setq having-next-defun
! 			   (c-end-of-defun))
! 		     (c-beginning-of-defun)
! 		     (setq next-defun-beginning (point)))
! 
! 		   (if (and having-next-defun
! 			    (< location next-defun-beginning))
! 		       (skip-syntax-forward " "))
! 		   (if (and having-previous-defun
! 			    (> location previous-defun-end))
! 		       (skip-syntax-backward " "))
! 		   (unless (or
! 			    ;; When there is no previous defun, the
! 			    ;; point is not in a defun if it is not at
! 			    ;; the beginning of the next defun.
! 			    (and (not having-previous-defun)
! 				 (not (= (point)
! 					 next-defun-beginning)))
! 			    ;; When there is no next defun, the point
! 			    ;; is not in a defun if it is not at the
! 			    ;; end of the previous defun.
! 			    (and (not having-next-defun)
! 				 (not (= (point)
! 					 previous-defun-end)))
! 			    ;; If the point is between two defuns, it
! 			    ;; is not in a defun.
! 			    (and (> (point) previous-defun-end)
! 				 (< (point) next-defun-beginning)))
! 		     ;; If the point is already at the beginning of a
! 		     ;; defun, there is no need to move point again.
! 		     (if (not (= (point) next-defun-beginning))
! 			 (c-beginning-of-defun))
! 		     ;; Is this a DEFUN construct?  And is LOCATION in it?
! 		     (if (and (looking-at "DEFUN\\b")
! 			      (>= location (point)))
!                          ;; DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory, ...) ==> Ffile_name_directory
!                          ;; DEFUN(POSIX::STREAM-LOCK, stream lockp &key BLOCK SHARED START LENGTH) ==> POSIX::STREAM-LOCK
! 			 (progn
! 			   (down-list 1)
! 			   (when (= (char-after (point)) ?\")
!                              (forward-sexp 1)
!                              (search-forward ","))
!                            (skip-syntax-forward " ")
! 			   (buffer-substring-no-properties
! 			    (point)
! 			    (progn (search-forward ",")
!                                    (forward-char -1)
!                                    (skip-syntax-backward " ")
! 				   (point))))
! 		       (if (looking-at "^[+-]")
! 			   ;; Objective-C
! 			   (change-log-get-method-definition)
! 			 ;; Ordinary C function syntax.
! 			 (let ((beg (point)))
! 			   (if (and
! 				;; Protect against "Unbalanced parens" error.
! 				(condition-case nil
! 				    (progn
! 				      (down-list 1) ; into arglist
! 				      (backward-up-list 1)
! 				      (skip-chars-backward " \t")
! 				      t)
! 				  (error nil))
! 				;; Verify initial pos was after
! 				;; real start of function.
! 				(save-excursion
! 				  (goto-char beg)
! 				  ;; For this purpose, include the line
! 				  ;; that has the decl keywords.  This
! 				  ;; may also include some of the
! 				  ;; comments before the function.
! 				  (while (and (not (bobp))
! 					      (save-excursion
! 						(forward-line -1)
! 						(looking-at "[^\n\f]")))
! 				    (forward-line -1))
! 				  (>= location (point)))
! 				;; Consistency check: going down and up
! 				;; shouldn't take us back before BEG.
! 				(> (point) beg))
! 			       (let (end middle)
! 				 ;; Don't include any final whitespace
! 				 ;; in the name we use.
! 				 (skip-chars-backward " \t\n")
! 				 (setq end (point))
! 				 (backward-sexp 1)
! 				 ;; Now find the right beginning of the name.
! 				 ;; Include certain keywords if they
! 				 ;; precede the name.
! 				 (setq middle (point))
! 				 ;; We tried calling `forward-sexp' in a loop
! 				 ;; but it causes inconsistency for C names.
! 				 (forward-sexp -1)
! 				 ;; Is this C++ method?
! 				 (when (and (< 2 middle)
! 					    (string= (buffer-substring (- middle 2)
! 								       middle)
! 						     "::"))
! 				   ;; Include "classname::".
! 				   (setq middle (point)))
! 				 ;; Ignore these subparts of a class decl
! 				 ;; and move back to the class name itself.
! 				 (while (looking-at "public \\|private ")
! 				   (skip-chars-backward " \t:")
! 				   (setq end (point))
! 				   (backward-sexp 1)
! 				   (setq middle (point))
! 				   (forward-word -1))
! 				 (and (bolp)
! 				      (looking-at
! 				       "enum \\|struct \\|union \\|class ")
! 				      (setq middle (point)))
! 				 (goto-char end)
! 				 (when (eq (preceding-char) ?=)
! 				   (forward-char -1)
! 				   (skip-chars-backward " \t")
! 				   (setq end (point)))
! 				 (buffer-substring-no-properties
! 				  middle end)))))))))
  		((memq major-mode add-log-tex-like-modes)
  		 (if (re-search-backward
  		      "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)"
--- 798,806 ----
  		   (buffer-substring-no-properties (point)
  						   (progn (forward-sexp 1)
  							  (point)))))
  		((memq major-mode add-log-c-like-modes)
! 		 (or (c-cpp-define-name)
! 		     (c-defun-name)))
  		((memq major-mode add-log-tex-like-modes)
  		 (if (re-search-backward
  		      "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)"


-- 
Alan Mackenzie (Nuremberg, Germany).