;;; 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, 2008 Free Software Foundation, Inc.
+;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: tools
:type '(choice (const :tag "default" nil)
string)
:group 'change-log)
+;;;###autoload
(put 'change-log-default-name 'safe-local-variable 'string-or-null-p)
(defcustom change-log-mode-hook nil
:group 'change-log)
(defcustom change-log-version-number-regexp-list
- (let ((re "\\([0-9]+\.[0-9.]+\\)"))
+ (let ((re "\\([0-9]+\.[0-9.]+\\)"))
(list
;; (defconst ad-version "2.15"
(concat "^(def[^ \t\n]+[ \t]+[^ \t\n][ \t]\"" re)
(match-string-no-properties 2)
;; Look backwards for either a file name or the log entry start.
(if (re-search-backward
- (concat "\\(" change-log-start-entry-re
+ (concat "\\(" change-log-start-entry-re
"\\)\\|\\("
change-log-file-names-re "\\)") nil t)
(if (match-beginning 1)
(defun change-log-search-tag-name (&optional at)
"Search for a tag name near `point'.
-Optional argument AT non-nil means search near buffer position
-AT. Return value is a cons whose car is the string representing
+Optional argument AT non-nil means search near buffer position AT.
+Return value is a cons whose car is the string representing
the tag and whose cdr is the position where the tag was found."
(save-excursion
(goto-char (setq at (or at (point))))
(change-log-search-tag-name-1 at)))
(error nil))
(condition-case nil
- ;; Before parenthesized list?
+ ;; Before parenthesized list on same line?
(save-excursion
(when (and (skip-chars-forward " \t")
(looking-at change-log-tag-re))
(change-log-search-tag-name-1)))
(error nil))
(condition-case nil
- ;; Near filename?
+ ;; Near file name?
(save-excursion
(when (and (progn
(beginning-of-line)
(change-log-search-tag-name-1)))
(error nil))
(condition-case nil
- ;; Before filename?
- (save-excursion
- (when (and (progn
- (skip-syntax-backward " ")
- (beginning-of-line)
- (looking-at change-log-file-names-re))
- (goto-char (match-end 0))
- (skip-syntax-forward " ")
- (looking-at change-log-tag-re))
- (change-log-search-tag-name-1)))
- (error nil))
- (condition-case nil
- ;; Near start entry?
- (save-excursion
- (when (and (progn
- (beginning-of-line)
- (looking-at change-log-start-entry-re))
- (forward-line) ; Won't work for multiple
- ; names, etc.
- (skip-syntax-forward " ")
- (progn
- (beginning-of-line)
- (looking-at change-log-file-names-re))
- (goto-char (match-end 0))
- (re-search-forward change-log-tag-re))
- (change-log-search-tag-name-1)))
- (error nil))
- (condition-case nil
- ;; After parenthesized list?.
- (when (re-search-backward change-log-tag-re)
- (save-restriction
- (narrow-to-region (match-beginning 1) (match-end 1))
- (goto-char (point-max))
- (cons (find-tag-default) (point-max))))
+ ;; Anywhere else within current entry?
+ (let ((from
+ (save-excursion
+ (end-of-line)
+ (if (re-search-backward change-log-start-entry-re nil t)
+ (match-beginning 0)
+ (point-min))))
+ (to
+ (save-excursion
+ (end-of-line)
+ (if (re-search-forward change-log-start-entry-re nil t)
+ (match-beginning 0)
+ (point-max)))))
+ (when (and (< from to) (<= from at) (<= at to))
+ (save-restriction
+ ;; Narrow to current change log entry.
+ (narrow-to-region from to)
+ (cond
+ ((re-search-backward change-log-tag-re nil t)
+ (narrow-to-region (match-beginning 1) (match-end 1))
+ (goto-char (point-max))
+ (cons (find-tag-default) (point-max)))
+ ((re-search-forward change-log-tag-re nil t)
+ (narrow-to-region (match-beginning 1) (match-end 1))
+ (goto-char (point-min))
+ (cons (find-tag-default) (point-min)))))))
(error nil))))))
(defvar change-log-find-head nil)
(defvar change-log-find-tail nil)
+(defvar change-log-find-window nil)
(defun change-log-goto-source-1 (tag regexp file buffer
&optional window first last)
;; Record this as first match when there's none.
(unless first (setq first last)))))))
(if (or last first)
- (with-selected-window (or window (display-buffer buffer))
+ (with-selected-window
+ (setq change-log-find-window (or window (display-buffer buffer)))
(if last
(progn
(when (or (< last (point-min)) (> last (point-max)))
nil)))
(defun change-log-goto-source ()
- "Go to source location of change log tag near `point'.
+ "Go to source location of \"change log tag\" near `point'.
A change log tag is a symbol within a parenthesized,
-comma-separated list."
+comma-separated list. If no suitable tag can be found nearby,
+try to visit the file for the change under `point' instead."
(interactive)
(if (and (eq last-command 'change-log-goto-source)
change-log-find-tail)
(car change-log-find-head)
(nth 2 change-log-find-head)))))
(save-excursion
- (let* ((tag-at (change-log-search-tag-name))
+ (let* ((at (point))
+ (tag-at (change-log-search-tag-name))
(tag (car tag-at))
- (file (when tag-at
- (change-log-search-file-name (cdr tag-at)))))
- (if (or (not tag) (not file))
- (error "No suitable tag near `point'")
+ (file (when tag-at (change-log-search-file-name (cdr tag-at))))
+ (file-at (when file (match-beginning 2)))
+ ;; `file-2' is the file `change-log-search-file-name' finds
+ ;; at `point'. We use `file-2' as a fallback when `tag' or
+ ;; `file' are not suitable for some reason.
+ (file-2 (change-log-search-file-name at))
+ (file-2-at (when file-2 (match-beginning 2))))
+ (cond
+ ((and (or (not tag) (not file) (not (file-exists-p file)))
+ (or (not file-2) (not (file-exists-p file-2))))
+ (error "Cannot find tag or file near `point'"))
+ ((and file-2 (file-exists-p file-2)
+ (or (not tag) (not file) (not (file-exists-p file))
+ (and (or (and (< file-at file-2-at) (<= file-2-at at))
+ (and (<= at file-2-at) (< file-2-at file-at))))))
+ ;; We either have not found a suitable file name or `file-2'
+ ;; provides a "better" file name wrt `point'. Go to the
+ ;; buffer of `file-2' instead.
+ (setq change-log-find-window
+ (display-buffer (find-file-noselect file-2))))
+ (t
(setq change-log-find-head
(list tag (concat "\\_<" (regexp-quote tag) "\\_>")
file (find-file-noselect file)))
(condition-case nil
(setq change-log-find-tail
(apply 'change-log-goto-source-1 change-log-find-head))
- (error (format "Cannot find matches for tag `%s' in `%s'"
- tag file))))))))
+ (error
+ (format "Cannot find matches for tag `%s' in file `%s'"
+ tag file)))))))))
(defun change-log-next-error (&optional argp reset)
- "Move to the Nth (default 1) next match in an Occur mode buffer.
+ "Move to the Nth (default 1) next match in a ChangeLog buffer.
Compatibility function for \\[next-error] invocations."
(interactive "p")
(let* ((argp (or argp 0))
(down (< argp 0)) ; are we going down? (is argp negative?)
(up (not down))
(search-function (if up 're-search-forward 're-search-backward)))
-
+
;; set the starting position
(goto-char (cond (reset (point-min))
(down (line-beginning-position))
(up (line-end-position))
((point))))
-
+
(funcall search-function change-log-file-names-re nil t count))
-
+
(beginning-of-line)
;; if we found a place to visit...
(when (looking-at change-log-file-names-re)
- (change-log-goto-source)))
+ (let (change-log-find-window)
+ (change-log-goto-source)
+ (when change-log-find-window
+ ;; Select window displaying source file.
+ (select-window change-log-find-window)))))
(defvar change-log-mode-map
(let ((map (make-sparse-keymap)))
regexps nil))))
version)))))
+(declare-function diff-find-source-location "diff-mode"
+ (&optional other-file reverse noprompt))
;;;###autoload
(defun find-change-log (&optional file-name buffer-file)
Once a file is found, `change-log-default-name' is set locally in the
current buffer to the complete file name.
Optional arg BUFFER-FILE overrides `buffer-file-name'."
- ;; If user specified a file name or if this buffer knows which one to use,
- ;; just use that.
- (or file-name
- (setq file-name (and change-log-default-name
- (file-name-directory change-log-default-name)
- change-log-default-name))
- (progn
- ;; Chase links in the source file
- ;; and use the change log in the dir where it points.
- (setq file-name (or (and (or buffer-file buffer-file-name)
- (file-name-directory
- (file-chase-links
- (or buffer-file buffer-file-name))))
- default-directory))
- (if (file-directory-p file-name)
- (setq file-name (expand-file-name (change-log-name) file-name)))
- ;; Chase links before visiting the file.
- ;; This makes it easier to use a single change log file
- ;; for several related directories.
- (setq file-name (file-chase-links file-name))
- (setq file-name (expand-file-name file-name))
- ;; Move up in the dir hierarchy till we find a change log file.
- (let ((file1 file-name)
- parent-dir)
- (while (and (not (or (get-file-buffer file1) (file-exists-p file1)))
- (progn (setq parent-dir
+ ;; If we are called from a diff, first switch to the source buffer;
+ ;; in order to respect buffer-local settings of change-log-default-name, etc.
+ (with-current-buffer (let ((buff (if (eq major-mode 'diff-mode)
+ (car (ignore-errors
+ (diff-find-source-location))))))
+ (if (buffer-live-p buff) buff
+ (current-buffer)))
+ ;; If user specified a file name or if this buffer knows which one to use,
+ ;; just use that.
+ (or file-name
+ (setq file-name (and change-log-default-name
+ (file-name-directory change-log-default-name)
+ change-log-default-name))
+ (progn
+ ;; Chase links in the source file
+ ;; and use the change log in the dir where it points.
+ (setq file-name (or (and (or buffer-file buffer-file-name)
(file-name-directory
- (directory-file-name
- (file-name-directory file1))))
- ;; Give up if we are already at the root dir.
- (not (string= (file-name-directory file1)
- parent-dir))))
- ;; Move up to the parent dir and try again.
- (setq file1 (expand-file-name
- (file-name-nondirectory (change-log-name))
- parent-dir)))
- ;; If we found a change log in a parent, use that.
- (if (or (get-file-buffer file1) (file-exists-p file1))
- (setq file-name file1)))))
- ;; Make a local variable in this buffer so we needn't search again.
- (set (make-local-variable 'change-log-default-name) file-name)
+ (file-chase-links
+ (or buffer-file buffer-file-name))))
+ default-directory))
+ (if (file-directory-p file-name)
+ (setq file-name (expand-file-name (change-log-name) file-name)))
+ ;; Chase links before visiting the file.
+ ;; This makes it easier to use a single change log file
+ ;; for several related directories.
+ (setq file-name (file-chase-links file-name))
+ (setq file-name (expand-file-name file-name))
+ ;; Move up in the dir hierarchy till we find a change log file.
+ (let ((file1 file-name)
+ parent-dir)
+ (while (and (not (or (get-file-buffer file1) (file-exists-p file1)))
+ (progn (setq parent-dir
+ (file-name-directory
+ (directory-file-name
+ (file-name-directory file1))))
+ ;; Give up if we are already at the root dir.
+ (not (string= (file-name-directory file1)
+ parent-dir))))
+ ;; Move up to the parent dir and try again.
+ (setq file1 (expand-file-name
+ (file-name-nondirectory (change-log-name))
+ parent-dir)))
+ ;; If we found a change log in a parent, use that.
+ (if (or (get-file-buffer file1) (file-exists-p file1))
+ (setq file-name file1)))))
+ ;; Make a local variable in this buffer so we needn't search again.
+ (set (make-local-variable 'change-log-default-name) file-name))
file-name)
(defun add-log-file-name (buffer-file log-file)
;;;###autoload
(define-derived-mode change-log-mode text-mode "Change Log"
- "Major mode for editing change logs; like Indented Text Mode.
+ "Major mode for editing change logs; like Indented Text mode.
Prevents numeric backups and sets `left-margin' to 8 and `fill-column' to 74.
New log entries are usually made with \\[add-change-log-entry] or \\[add-change-log-entry-other-window].
Each entry behaves as a paragraph, and the entries for one day as a page.
Runs `change-log-mode-hook'.
-\\{change-log-mode-map}"
+\n\\{change-log-mode-map}"
(setq left-margin 8
fill-column 74
indent-tabs-mode t
'(change-log-font-lock-keywords t nil nil backward-paragraph))
(set (make-local-variable 'multi-isearch-next-buffer-function)
'change-log-next-buffer)
- (set (make-local-variable 'beginning-of-defun-function)
+ (set (make-local-variable 'beginning-of-defun-function)
'change-log-beginning-of-defun)
- (set (make-local-variable 'end-of-defun-function)
+ (set (make-local-variable 'end-of-defun-function)
'change-log-end-of-defun)
;; next-error function glue
(setq next-error-function 'change-log-next-error)
HCoop / bpt / emacs.git / blobdiff