emacs: lisp/add-log.el comparison

comparison lisp/add-log.el @ 28446:28009885f082

Don't require cl, fortran. (add-log-current-defun-function): Doc fix. (change-log-version-number-regexp-list): Remove SCCS stuff. Doc fix. (change-log-mode-map): Defvar directly. (change-log-version-rcs): Function deleted. (change-log-version-number-search): Doc fix.

author	Dave Love <fx@gnu.org>
date	Fri, 31 Mar 2000 16:00:08 +0000
parents	c11a0bbb5c88
children	e5643646a988

comparison

equal deleted inserted replaced

-:765d0ff9037d
+:28009885f082
 ;;; add-log.el --- change log maintenance commands for Emacs
-;; Copyright (C) 1985, 86, 88, 93, 94, 97, 1998, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 86, 88, 93, 94, 97, 98, 2000 Free Software Foundation, Inc.
 ;; Keywords: tools
 ;; This file is part of GNU Emacs.
 ;; This facility is documented in the Emacs Manual.
 ;;; Code:
 (eval-when-compile
-(require 'fortran)
+(require 'timezone))
-(require 'timezone)
-(require 'cl))
 (defgroup change-log nil
 "Change log maintenance"
 :group 'tools
 :link '(custom-manual "(emacs)Change Log")
 "Normal hook run by `change-log-mode'."
 :type 'hook
 :group 'change-log)
 (defcustom add-log-current-defun-function nil
-"\
+"*If non-nil, function to guess name of surrounding function.
-*If non-nil, function to guess name of current function from surrounding text.
+It is used by `add-log-current-defun' in preference to built-in rules.
-\\[add-change-log-entry] calls this function (if nil, `add-log-current-defun'
+Returns function's name as a string, or nil if outside a function."
-instead) with no arguments.  It returns a string or nil if it cannot guess."
 :type 'function
 :group 'change-log)
 ;;;###autoload
 (defcustom add-log-full-name nil
 (let ((re    "\\([0-9]+\.[0-9.]+\\)"))
 (list
 ;;  (defconst ad-version "2.15"
 (concat "^(def[^ \t\n]+[ \t]+[^ \t\n][ \t]\"" re)
 ;; Revision: pcl-cvs.el,v 1.72 1999/09/05 20:21:54 monnier Exp
-(concat "^;+ *Revision: +[^ \t\n]+[ \t]+" re)
+(concat "^;+ *Revision: +[^ \t\n]+[ \t]+" re)))
-;; SCCS @(#)igrep.el 2.83
-(concat "SCCS[ \t]+@(#).*[ \t]+" re)
-))
 "*List of regexps to search for version number.
+The version number must be in group 1.
 Note: The search is conducted only within 10%, at the beginning of the file."
 :version "21.1"
 :type '(repeat regexp)
 :group 'change-log)
 1 font-lock-comment-face)
 ("  \\(From\\|Patch\\(es\\)? by\\|Report\\(ed by\\| from\\)\\|Suggest\\(ed by\\|ion from\\)\\)"
 1 font-lock-comment-face))
 "Additional expressions to highlight in Change Log mode.")
-(defvar change-log-mode-map nil
+(defvar change-log-mode-map (make-sparse-keymap)
 "Keymap for Change Log major mode.")
-(if change-log-mode-map
-nil
-(setq change-log-mode-map (make-sparse-keymap)))
 (defvar change-log-time-zone-rule nil
 "Time zone used for calculating change log time stamps.
 It takes the same format as the TZ argument of `set-time-zone-rule'.
 If nil, use local time.")
 (if (file-directory-p name)
 	  (expand-file-name (file-name-nondirectory default)
 			    (file-name-as-directory name))
 	name))))
-(defun change-log-version-rcs (rcs-string &optional end)
-"Search for plain RCS-STRING from whole buffer up till END.
-The surrounding $ characters fro RCS-STRING are added in this function;
-provide argument e.g. as \"Id\"."
-(let (str)
-(save-excursion
-(goto-char (point-min))
-(when (re-search-forward
-	     (concat "[$]" rcs-string ":[^\n$]+[$]")
-	     end t)
-	(setq str (match-string 0))
-	(when (string-match "[0-9]+\.[0-9.]+" str)
-	  (match-string 0 str))))))
 (defun change-log-version-number-search ()
-"Return version number for the file by searchin version control tags."
+"Return version number of current buffer's file.
+This is the value returned by `vc-workfile-version' or, if that is
+nil, by matching `change-log-version-number-regexp-list'."
 (let* ((size (buffer-size))
 	 (end
-	  ;;  The version number can be anywhere in the file, but restrict
+	  ;; The version number can be anywhere in the file, but
-	  ;;  search to the file beginning: 10% should be enough to prevent
+	  ;; restrict search to the file beginning: 10% should be
-	  ;;  some mishits.
+	  ;; enough to prevent some mishits.
 	  ;;
-	  ;;  Apply percentage only if buffer size is bigger than approx 100 lines
+	  ;; Apply percentage only if buffer size is bigger than
+	  ;; approx 100 lines.
 	  (if (> size (* 100 80))
-	      (/ (* (buffer-size) 10) 100)
+	      (/ size 10)
 	    size))
 	 version)
+(or (and buffer-file-name
-;; Search RCS, CVS version strings
+	     (vc-workfile-version buffer-file-name))
+	(save-restriction
-(dolist (choice '("Revision" "Id"))
+	  (widen)
-(when (setq version (change-log-version-rcs choice end))
+	  (let ((regexps change-log-version-number-regexp-list))
-	(return)))
+	    (while regexps
+	      (save-excursion
-(unless version
+		(goto-char (point-min))
-(dolist (regexp change-log-version-number-regexp-list)
+		(when (re-search-forward (pop regexps) end t)
-	(save-excursion
+		  (setq version (match-string 1)
-	  (goto-char (point-min))
+			regexps nil)))))))))
-	  (when (re-search-forward regexp end t)
-	    (setq version (match-string 1))
-	    (return)))))
-version
-))
 ;;;###autoload
 (defun find-change-log (&optional file-name)
 "Find a change log file for \\[add-change-log-entry] and return the name.
 	 ;; full name which look silly when inserted.  Rather than do
 	 ;; anything about that here, let user give prefix argument so that
 	 ;; s/he can edit the full name field in prompter if s/he wants.
 	(setq add-log-mailing-address
 	      (read-input "Mailing address: " add-log-mailing-address))))
-(let ((defun (funcall (or add-log-current-defun-function
+(let ((defun (add-log-current-defun))
-			    'add-log-current-defun)))
 	(version (and change-log-version-info-enabled
 		      (change-log-version-number-search)))
-	bound
+	bound entry)
-	entry)
 (setq file-name (expand-file-name (find-change-log file-name)))
 ;; Set ENTRY to the file name to use in the new entry.
 (and buffer-file-name
 	   ;; Add to the existing entry for the same file.
 	   (re-search-forward "^\\s *$\\|^\\s \\*")
 	   (goto-char (match-beginning 0))
 	   ;; Delete excess empty lines; make just 2.
 	   (while (and (not (eobp)) (looking-at "^\\s *$"))
-	     (delete-region (point) (save-excursion (forward-line 1) (point))))
+	     (delete-region (point) (line-beginning-position 2)))
 	   (insert "\n\n")
 	   (forward-line -2)
 	   (indent-relative-maybe))
 	  (t
 	   ;; Make a new entry.
 	   (forward-line 1)
 	   (while (looking-at "\\sW")
 	     (forward-line 1))
 	   (while (and (not (eobp)) (looking-at "^\\s *$"))
-	     (delete-region (point) (save-excursion (forward-line 1) (point))))
+	     (delete-region (point) (line-beginning-position 2)))
 	   (insert "\n\n\n")
 	   (forward-line -2)
 	   (indent-to left-margin)
-	   (insert "* " (or entry ""))
+	   (insert "* " (or entry ""))))
-	   ))
 ;; Now insert the function name, if we have one.
 ;; Point is at the entry for this file,
 ;; either at the end of the line or at the first blank line.
 (if defun
 	(progn
 	  ;; Make it easy to get rid of the function name.
 	  (undo-boundary)
-	  (insert (if (save-excursion
+	  (unless (save-excursion
-			(beginning-of-line 1)
+		    (beginning-of-line 1)
-			(looking-at "\\s *$"))
+		    (looking-at "\\s *$"))
-		      ""
+	    (insert ?\ ))
-		    " ")
+	  (insert "(" defun "): ")
-		  "(" defun "): "
+	  (if version
-		  (if version
+	      (insert version ?\ )))
-		      (concat version " ")
-		    "")))
 ;; No function name, so put in a colon unless we have just a star.
-(if (not (save-excursion
+(unless (save-excursion
-		 (beginning-of-line 1)
+		(beginning-of-line 1)
-		 (looking-at "\\s *\\(\\*\\s *\\)?$")))
+		(looking-at "\\s *\\(\\*\\s *\\)?$"))
-	  (insert ": "
+	(insert ": ")
-		  (if version
+	(if version (insert version ?\ ))))))
-		      (concat version " ") ""))))))
 ;;;###autoload
 (defun add-change-log-entry-other-window (&optional whoami file-name)
 "Find change log file in other window and add an entry for today.
 Optional arg WHOAMI (interactive prefix) non-nil means prompt for user
 ;;;###autoload
 (defun add-log-current-defun ()
 "Return name of function definition point is in, or nil.
 Understands C, Lisp, LaTeX (\"functions\" are chapters, sections, ...),
-Texinfo (@node titles), Perl, and Fortran.
+Texinfo (@node titles) and Perl.
 Other modes are handled by a heuristic that looks in the 10K before
 point for uppercase headings starting in the first column or
-identifiers followed by `:' or `=', see variables
+identifiers followed by `:' or `='.  See variables
 `add-log-current-defun-header-regexp' and
 `add-log-current-defun-function'
 Has a preference of looking backwards."
 (condition-case nil
 (save-excursion
 	(let ((location (point)))
-	  (cond ((and (functionp add-log-current-defun-function)
+	  (cond (add-log-current-defun-function
-		      (funcall add-log-current-defun-function)))
+		 (funcall add-log-current-defun-function))
 		((memq major-mode add-log-lisp-like-modes)
 		 ;; If we are now precisely at the beginning of a defun,
 		 ;; make sure beginning-of-defun finds that one
 		 ;; rather than the previous one.
 		 (or (eobp) (forward-char 1))
 		 (beginning-of-defun)
-		 ;; Make sure we are really inside the defun found, not after it.
+		 ;; Make sure we are really inside the defun found,
+		 ;; not after it.
 		 (when (and (looking-at "\\s(")
 			    (progn (end-of-defun)
 				   (< location (point)))
 			    (progn (forward-sexp -1)
 				   (>= location (point))))
 		   ;; or "defvar".
 		   (forward-sexp 1)
 		   ;; The second element is usually a symbol being defined.
 		   ;; If it is not, use the first symbol in it.
 		   (skip-chars-forward " \t\n'(")
-		   (buffer-substring (point)
+		   (buffer-substring-no-properties (point)
-				     (progn (forward-sexp 1)
+						   (progn (forward-sexp 1)
-					    (point)))))
+							  (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
 		 (beginning-of-line)
 		 (while (eq (char-after (- (point) 2)) ?\\) ;not =; note above
 		   (forward-line -1))
 		 (search-forward "define")
 		 (skip-chars-forward " \t")
-		 (buffer-substring (point)
+		 (buffer-substring-no-properties (point)
-				   (progn (forward-sexp 1) (point))))
+						 (progn (forward-sexp 1)
+							(point))))
 		((memq major-mode add-log-c-like-modes)
 		 (beginning-of-line)
 		 ;; See if we are in the beginning part of a function,
 		 ;; before the open brace.  If so, advance forward.
 		 (while (not (looking-at "{\\|\\(\\s *$\\)"))
 		   (forward-line 1))
 		 (or (eobp)
 		     (forward-char 1))
 		 (beginning-of-defun)
-		 (if (progn (end-of-defun)
+		 (when (progn (end-of-defun)
-			    (< location (point)))
+			      (< location (point)))
-		     (progn
+		   (backward-sexp 1)
-		       (backward-sexp 1)
+		   (let (beg tem)
-		       (let (beg tem)
+		     (forward-line -1)
-			 (forward-line -1)
+		     ;; Skip back over typedefs of arglist.
-			 ;; Skip back over typedefs of arglist.
+		     (while (and (not (bobp))
-			 (while (and (not (bobp))
+				 (looking-at "[ \t\n]"))
-				     (looking-at "[ \t\n]"))
+		       (forward-line -1))
-			   (forward-line -1))
+		     ;; See if this is using the DEFUN macro used in Emacs,
-			 ;; See if this is using the DEFUN macro used in Emacs,
+		     ;; or the DEFUN macro used by the C library.
-			 ;; or the DEFUN macro used by the C library.
+		     (if (condition-case nil
-			 (if (condition-case nil
+			     (and (save-excursion
-				 (and (save-excursion
+				    (end-of-line)
-					(end-of-line)
+				    (while (= (preceding-char) ?\\)
-					(while (= (preceding-char) ?\\)
+				      (end-of-line 2))
-					  (end-of-line 2))
+				    (backward-sexp 1)
-					(backward-sexp 1)
+				    (beginning-of-line)
-					(beginning-of-line)
+				    (setq tem (point))
-					(setq tem (point))
+				    (looking-at "DEFUN\\b"))
-					(looking-at "DEFUN\\b"))
+				  (>= location tem))
-				      (>= location tem))
+			   (error nil))
-			       (error nil))
+			 (progn
-			     (progn
+			   (goto-char tem)
-			       (goto-char tem)
+			   (down-list 1)
-			       (down-list 1)
+			   (if (= (char-after (point)) ?\")
-			       (if (= (char-after (point)) ?\")
+			       (progn
-				   (progn
+				 (forward-sexp 1)
-				     (forward-sexp 1)
+				 (skip-chars-forward " ,")))
-				     (skip-chars-forward " ,")))
+			   (buffer-substring-no-properties
-			       (buffer-substring (point)
+			    (point)
-						 (progn (forward-sexp 1) (point))))
+			    (progn (forward-sexp 1)
-(if (looking-at "^[+-]")
+				   (point))))
-(change-log-get-method-definition)
+		       (if (looking-at "^[+-]")
-;; Ordinary C function syntax.
+			   (change-log-get-method-definition)
-(setq beg (point))
+			 ;; Ordinary C function syntax.
-(if (and (condition-case nil
+			 (setq beg (point))
-					  ;; Protect against "Unbalanced parens" error.
+			 (if (and
-					  (progn
+			      ;; Protect against "Unbalanced parens" error.
-					    (down-list 1) ; into arglist
+			      (condition-case nil
-					    (backward-up-list 1)
+				  (progn
-					    (skip-chars-backward " \t")
+				    (down-list 1) ; into arglist
-					    t)
+				    (backward-up-list 1)
-					(error nil))
+				    (skip-chars-backward " \t")
-				      ;; Verify initial pos was after
+				    t)
-				      ;; real start of function.
+				(error nil))
-				      (save-excursion
+			      ;; Verify initial pos was after
-					(goto-char beg)
+			      ;; real start of function.
-					;; For this purpose, include the line
+			      (save-excursion
-					;; that has the decl keywords.  This
+				(goto-char beg)
-					;; may also include some of the
+				;; For this purpose, include the line
-					;; comments before the function.
+				;; that has the decl keywords.  This
-					(while (and (not (bobp))
+				;; may also include some of the
-						    (save-excursion
+				;; comments before the function.
-						      (forward-line -1)
+				(while (and (not (bobp))
-						      (looking-at "[^\n\f]")))
+					    (save-excursion
-					  (forward-line -1))
+					      (forward-line -1)
-					(>= location (point)))
+					      (looking-at "[^\n\f]")))
-;; Consistency check: going down and up
+				  (forward-line -1))
-;; shouldn't take us back before BEG.
+				(>= location (point)))
-(> (point) beg))
+			      ;; Consistency check: going down and up
-				 (let (end middle)
+			      ;; shouldn't take us back before BEG.
-				   ;; Don't include any final whitespace
+			      (> (point) beg))
-				   ;; in the name we use.
+			     (let (end middle)
-				   (skip-chars-backward " \t\n")
+			       ;; Don't include any final whitespace
-				   (setq end (point))
+			       ;; in the name we use.
-				   (backward-sexp 1)
+			       (skip-chars-backward " \t\n")
-				   ;; Now find the right beginning of the name.
+			       (setq end (point))
-				   ;; Include certain keywords if they
+			       (backward-sexp 1)
-				   ;; precede the name.
+			       ;; Now find the right beginning of the name.
-				   (setq middle (point))
+			       ;; Include certain keywords if they
-				   (forward-word -1)
+			       ;; precede the name.
-				   ;; Ignore these subparts of a class decl
+			       (setq middle (point))
-				   ;; and move back to the class name itself.
+			       (forward-word -1)
-				   (while (looking-at "public \\|private ")
+			       ;; Ignore these subparts of a class decl
-				     (skip-chars-backward " \t:")
+			       ;; and move back to the class name itself.
-				     (setq end (point))
+			       (while (looking-at "public \\|private ")
-				     (backward-sexp 1)
+				 (skip-chars-backward " \t:")
-				     (setq middle (point))
+				 (setq end (point))
-				     (forward-word -1))
+				 (backward-sexp 1)
-				   (and (bolp)
+				 (setq middle (point))
-					(looking-at "enum \\|struct \\|union \\|class ")
+				 (forward-word -1))
-					(setq middle (point)))
+			       (and (bolp)
-				   (goto-char end)
+				    (looking-at
-				   (when (eq (preceding-char) ?=)
+				     "enum \\|struct \\|union \\|class ")
-				     (forward-char -1)
+				    (setq middle (point)))
-				     (skip-chars-backward " \t")
+			       (goto-char end)
-				     (setq end (point)))
+			       (when (eq (preceding-char) ?=)
-				   (buffer-substring middle end)))))))))
+				 (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\\)" nil t)
+		      "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)"
+		      nil t)
 		     (progn
 		       (goto-char (match-beginning 0))
-		       (buffer-substring (1+ (point));; without initial backslash
+		       (buffer-substring-no-properties
-					 (progn
+			(1+ (point))	; without initial backslash
-					   (end-of-line)
+			(line-end-position)))))
-					   (point))))))
 		((eq major-mode 'texinfo-mode)
 		 (if (re-search-backward "^@node[ \t]+\\([^,\n]+\\)" nil t)
-		     (buffer-substring (match-beginning 1)
+		     (match-string-no-properties 1)))
-				       (match-end 1))))
 		((eq major-mode 'perl-mode)
 		 (if (re-search-backward "^sub[ \t]+\\([^ \t\n]+\\)" nil t)
-		     (buffer-substring (match-beginning 1)
+		     (match-string-no-properties 1)))
-				       (match-end 1))))
+		;; Emacs's autoconf-mode installs its own
+		;; `add-log-current-defun-function'.  This applies to
+		;; a different mode apparently for editing .m4
+		;; autoconf source.
 ((eq major-mode 'autoconf-mode)
-(if (re-search-backward "^\\(\\(m4_\\)?define\\|A._DEFUN\\)(\\[?\\([A-Za-z0-9_]+\\)" nil t)
+(if (re-search-backward
-(buffer-substring (match-beginning 3)
+		      "^\\(\\(m4_\\)?define\\|A._DEFUN\\)(\\[?\\([A-Za-z0-9_]+\\)" nil t)
-(match-end 3))))
+(match-string-no-properties 3)))
-((or (eq major-mode 'fortran-mode)
-		     ;; Needs work for f90, but better than nothing.
-		     (eq major-mode 'f90-mode))
-;; must be inside function body for this to work
-(fortran-beginning-of-subprogram)
-(let ((case-fold-search t)) ; case-insensitive
-;; search for fortran subprogram start
-(if (re-search-forward
-"^[ \t]*\\(program\\|subroutine\\|function\
-\\|[ \ta-z0-9*()]*[ \t]+function\\|\\(block[ \t]*data\\)\\)"
-(save-excursion (fortran-end-of-subprogram)
-(point))
-t)
-(or (match-string 2)
-(progn
-;; move to EOL or before first left paren
-(if (re-search-forward "[(\n]" nil t)
-				 (progn (backward-char)
-(skip-chars-backward " \t"))
-(end-of-line))
-;; Use the name preceding that.
-(buffer-substring (point)
-					       (progn (backward-sexp)
-						      (point)))))
-		     "main")))
 		(t
 		 ;; If all else fails, try heuristics
 		 (let (case-fold-search
 		       result)
 		   (end-of-line)
 		   (when (re-search-backward
 			  add-log-current-defun-header-regexp
 			  (- (point) 10000)
 			  t)
-		     (setq result (or (buffer-substring (match-beginning 1)
+		     (setq result (or (match-string-no-properties 1)
-							(match-end 1))
+				      (match-string-no-properties 0)))
-				      (buffer-substring (match-beginning 0)
-							(match-end 0))))
 		     ;; Strip whitespace away
 		     (when (string-match "\\([^ \t\n\r\f].*[^ \t\n\r\f]\\)"
 					 result)
-		       (setq result (match-string 1 result)))
+		       (setq result (match-string-no-properties 1 result)))
 		     result))))))
 (error nil)))
 (defvar change-log-get-method-definition-md)
 ;; Add the last match in the buffer to the end of `md',
 ;; followed by the string END; move to the end of that match.
 (defun change-log-get-method-definition-1 (end)
 (setq change-log-get-method-definition-md
 	(concat change-log-get-method-definition-md
-		(buffer-substring (match-beginning 1) (match-end 1))
+		(match-string 1)
 		end))
 (goto-char (match-end 0)))
 (defun change-log-get-method-definition ()
 "For objective C, return the method name if we are in a method."

Mercurial > emacs

comparison lisp/add-log.el @ 28446:28009885f082