X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/f76840f36cf60feecaf21d55d24ace948800fef7..f67b40b3d890918f1e856a5052f86c3c724f0658:/lisp/add-log.el diff --git a/lisp/add-log.el b/lisp/add-log.el index a58d631867..9702e7bad4 100644 --- a/lisp/add-log.el +++ b/lisp/add-log.el @@ -1,17 +1,17 @@ ;;; add-log.el --- change log maintenance commands for Emacs ;; Copyright (C) 1985, 1986, 1988, 1993, 1994, 1997, 1998, 2000, 2001, -;; 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. +;; 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: tools ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; 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, or (at your option) -;; any later version. +;; 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 @@ -19,9 +19,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -39,6 +37,7 @@ ;;; Code: (eval-when-compile + (require 'cl) ; ignore-errors (require 'timezone)) (defgroup change-log nil @@ -240,8 +239,11 @@ Note: The search is conducted only within 10%, at the beginning of the file." ;; backward-compatibility alias (put 'change-log-acknowledgement-face 'face-alias 'change-log-acknowledgement) +(defconst change-log-file-names-re "^\\( +\\|\t\\)\\* \\([^ ,:([\n]+\\)") +(defconst change-log-start-entry-re "^\\sw.........[0-9:+ ]*") + (defvar change-log-font-lock-keywords - '(;; + `(;; ;; Date lines, new (2000-01-01) and old (Sat Jan 1 00:00:00 2000) styles. ;; Fixme: this regepx is just an approximate one and may match ;; wrongly with a non-date line existing as a random note. In @@ -255,7 +257,7 @@ Note: The search is conducted only within 10%, at the beginning of the file." (2 'change-log-email))) ;; ;; File names. - ("^\\( +\\|\t\\)\\* \\([^ ,:([\n]+\\)" + (,change-log-file-names-re (2 'change-log-file) ;; Possibly further names in a list: ("\\=, \\([^ ,:([\n]+\\)" nil nil (1 'change-log-file)) @@ -287,10 +289,49 @@ Note: The search is conducted only within 10%, at the beginning of the file." 3 'change-log-acknowledgement)) "Additional expressions to highlight in Change Log mode.") +(defun change-log-search-file-name (where) + "Return the file-name for the change under point." + (save-excursion + (goto-char where) + (beginning-of-line 1) + (if (looking-at change-log-start-entry-re) + ;; We are at the start of an entry, search forward for a file + ;; name. + (progn + (re-search-forward change-log-file-names-re nil t) + (match-string 2)) + (if (looking-at change-log-file-names-re) + ;; We found a file name. + (match-string 2) + ;; Look backwards for either a file name or the log entry start. + (if (re-search-backward + (concat "\\(" change-log-start-entry-re + "\\)\\|\\(" + change-log-file-names-re "\\)") nil t) + (if (match-beginning 1) + ;; We got the start of the entry, look forward for a + ;; file name. + (progn + (re-search-forward change-log-file-names-re nil t) + (match-string 2)) + (match-string 4)) + ;; We must be before any file name, look forward. + (re-search-forward change-log-file-names-re nil t) + (match-string 2)))))) + +(defun change-log-find-file () + "Visit the file for the change under point." + (interactive) + (let ((file (change-log-search-file-name (point)))) + (if (and file (file-exists-p file)) + (find-file file) + (message "No such file or directory: %s" file)))) + (defvar change-log-mode-map (let ((map (make-sparse-keymap))) (define-key map [?\C-c ?\C-p] 'add-log-edit-prev-comment) (define-key map [?\C-c ?\C-n] 'add-log-edit-next-comment) + (define-key map [?\C-c ?\C-f] 'change-log-find-file) map) "Keymap for Change Log major mode.") @@ -664,7 +705,6 @@ the change log file in another window." (list current-prefix-arg (prompt-for-change-log-name)))) (add-change-log-entry whoami file-name t)) -;;;###autoload (define-key ctl-x-4-map "a" 'add-change-log-entry-other-window) (defvar change-log-indent-text 0) @@ -723,6 +763,7 @@ the change log file in another window." (defvar smerge-resolve-function) +(defvar copyright-at-end-flag) ;;;###autoload (define-derived-mode change-log-mode text-mode "Change Log" @@ -742,10 +783,11 @@ Runs `change-log-mode-hook'. ;; Avoid that filling leaves behind a single "*" on a line. (add-hook 'fill-nobreak-predicate '(lambda () - (looking-back "^\\s *\\*\\s *" (line-beginning-position))) + (looking-back "^\\s *\\*\\s *" (line-beginning-position))) nil t) (set (make-local-variable 'indent-line-function) 'change-log-indent) (set (make-local-variable 'tab-always-indent) nil) + (set (make-local-variable 'copyright-at-end-flag) t) ;; We really do want "^" in paragraph-start below: it is only the ;; lines that begin at column 0 (despite the left-margin of 8) that ;; we are looking for. Adding `* ' allows eliding the blank line @@ -760,7 +802,36 @@ Runs `change-log-mode-hook'. 'change-log-resolve-conflict) (set (make-local-variable 'adaptive-fill-regexp) "\\s *") (set (make-local-variable 'font-lock-defaults) - '(change-log-font-lock-keywords t nil nil backward-paragraph))) + '(change-log-font-lock-keywords t nil nil backward-paragraph)) + (set (make-local-variable 'isearch-buffers-next-buffer-function) + 'change-log-next-buffer) + (set (make-local-variable 'beginning-of-defun-function) + 'change-log-beginning-of-defun) + (set (make-local-variable 'end-of-defun-function) + 'change-log-end-of-defun) + (isearch-buffers-minor-mode)) + +(defun change-log-next-buffer (&optional buffer wrap) + "Return the next buffer in the series of ChangeLog file buffers. +This function is used for multiple buffers isearch. +A sequence of buffers is formed by ChangeLog files with decreasing +numeric file name suffixes in the directory of the initial ChangeLog +file were isearch was started." + (let* ((name (change-log-name)) + (files (cons name (sort (file-expand-wildcards + (concat name "[-.][0-9]*")) + (lambda (a b) + ;; The file's extension may not have a valid + ;; version form (e.g. VC backup revisions). + (ignore-errors + (version< (substring b (length name)) + (substring a (length name)))))))) + (files (if isearch-forward files (reverse files)))) + (find-file-noselect + (if wrap + (car files) + (cadr (member (file-name-nondirectory (buffer-file-name buffer)) + files)))))) ;; It might be nice to have a general feature to replace this. The idea I ;; have is a variable giving a regexp matching text which should not be @@ -801,6 +872,9 @@ Prefix arg means justify as well." '(TeX-mode plain-TeX-mode LaTeX-mode tex-mode) "*Modes that look like TeX to `add-log-current-defun'.") +(declare-function c-cpp-define-name "cc-cmds" ()) +(declare-function c-defun-name "cc-cmds" ()) + ;;;###autoload (defun add-log-current-defun () "Return name of function definition point is in, or nil. @@ -844,167 +918,10 @@ Has a preference of looking backwards." (buffer-substring-no-properties (point) (progn (forward-sexp 1) (point))))) - ((and (apply 'derived-mode-p 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)))) ((apply 'derived-mode-p 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))))))))) - ((apply 'derived-mode-p add-log-tex-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\\)" nil t) @@ -1077,7 +994,7 @@ Has a preference of looking backwards." "Return date of log entry in a consistent form for sorting. Point is assumed to be at the start of the entry." (require 'timezone) - (if (looking-at "^\\sw.........[0-9:+ ]*") + (if (looking-at change-log-start-entry-re) (let ((date (match-string-no-properties 0))) (if date (if (string-match "\\(....\\)-\\(..\\)-\\(..\\)\\s-+" date) @@ -1164,6 +1081,32 @@ old-style time formats for entries are supported." (goto-char (point-max))) (insert-buffer-substring other-buf start))))))) +(defun change-log-beginning-of-defun () + (re-search-backward change-log-start-entry-re nil 'move)) + +(defun change-log-end-of-defun () + ;; Look back and if there is no entry there it means we are before + ;; the first ChangeLog entry, so go forward until finding one. + (unless (save-excursion (re-search-backward change-log-start-entry-re nil t)) + (re-search-forward change-log-start-entry-re nil t)) + + ;; In case we are at the end of log entry going forward a line will + ;; make us find the next entry when searching. If we are inside of + ;; an entry going forward a line will still keep the point inside + ;; the same entry. + (forward-line 1) + + ;; In case we are at the beginning of an entry, move past it. + (when (looking-at change-log-start-entry-re) + (goto-char (match-end 0)) + (forward-line 1)) + + ;; Search for the start of the next log entry. Go to the end of the + ;; buffer if we could not find a next entry. + (when (re-search-forward change-log-start-entry-re nil 'move) + (goto-char (match-beginning 0)) + (forward-line -1))) + (provide 'add-log) ;; arch-tag: 81eee6fc-088f-4372-a37f-80ad9620e762