;;; patcher-change-log.el --- ChangeLog utilities ;; Copyright (C) 2008, 2009, 2010, 2011 Didier Verna ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007 Didier Verna ;; Author: Didier Verna ;; Maintainer: Didier Verna ;; Created: Sat Feb 13 22:20:24 2010 ;; Last Revision: Thu Jan 12 21:56:06 2012 ;; Keywords: maint ;; This file is part of Patcher. ;; Patcher is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License version 3, ;; as published by the Free Software Foundation. ;; Patcher is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program; if not, write to the Free Software ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; Contents management by FCM version 0.1. ;;; Code: (require 'cl) (eval-when-compile (require 'patcher-cutil)) (require 'patcher-util) (require 'patcher-project) (require 'patcher-instance) (require 'patcher-source) ;; ========================================================================== ;; Utilities ;; ========================================================================== (defgroup patcher-change-log nil "Patcher settings for ChangeLog buffers." :group 'patcher) (patcher-define-error 'change-log "Patcher ChangeLog error.") (defconst +patcher-change-log-entry-start-regexp+ "^[0-9]\\{4,4\\}-[0-9]\\{2,2\\}-[0-9]\\{2,2\\} " ;; Regexp matching the beginning of a ChangeLog entry ) ;; This function is based on find-change-log from the add-log library. (put 'patcher-locate-change-log 'lisp-indent-function 1) (defun* patcher-locate-change-log (project source &aux (change-log-file-name (patcher-project-option project :change-log-file-name))) ;; Locate PROJECT's ChangeLog file for SOURCE. ;; SOURCE must be an absolute file name. ;; If PROJECT does only ephemeral ChangeLogs, return always the same one, ;; located at the base directory. ;; If PROJECT doesn't have ChangeLogs yet, return a ChangeLog file in ;; SOURCE's directory (symlinks followed). Otherwise, try to find a ;; ChangeLog file the usual way. (if (eq (patcher-project-option project :change-logs-status) 'ephemeral) (expand-file-name change-log-file-name (patcher-project-base-directory project)) (setq source (file-truename source)) ;; follow SOURCE symlinks (let* ((directory (file-name-directory source)) (first-change-log (file-truename change-log-file-name directory))) (if (patcher-project-option project :change-logs-updating) (flet ((change-log-exists-p (change-log) (or (get-file-buffer change-log) (file-exists-p change-log)))) (let ((change-log first-change-log)) (while (and (not (change-log-exists-p change-log)) (let ((parent (file-name-directory (directory-file-name directory)))) (prog1 (not (string= parent directory)) (setq directory parent)))) (setq change-log (file-truename change-log-file-name directory))) (if (change-log-exists-p change-log) change-log first-change-log))) first-change-log)))) (put 'patcher-mapcar-change-log-extents 'lisp-indent-function 1) (defmacro* patcher-mapcar-change-log-extents ((var &optional buffer) &body body) ;; Mapcar BODY with VAR bound to all ChangeLog extents in BUFFER. `(patcher-mapcar-extents (,var 'change-log :here ,buffer) ,@body)) (defun patcher-change-logs (&optional buffer) ;; Return the list of ChangeLog absolute file names appearing in BUFFER. (patcher-collect-extents-property 'change-log buffer)) (defun patcher-change-log-extents (&optional buffer) ;; Return the list of ChangeLog extents in BUFFER. (patcher-extents 'change-log :here buffer)) (defun patcher-change-log-contents (&optional buffer) ;; Return the string containing all ChangeLog contents in BUFFER. (apply #'concat (patcher-mapcar-change-log-extents (extent buffer) (extent-string extent)))) (patcher-define-error 'change-logs-consistency "Patcher ChangeLogs consistency error." 'change-log) (defun patcher-detect-inconsistent-change-logs (project) ;; Detect inconsistent ChangLogs in PROJECT's process buffer diff. ;; Inconsistent means either spurious or missing diff. ;; Throw a change-logs-consistency error when detected. (multiple-value-bind (result spurious missing) (patcher-list= (patcher-change-logs (patcher-project-process-buffer project)) (patcher-project-change-logs project) :test #'string=) (unless result (patcher-error 'change-logs-consistency (when spurious (patcher-files-string spurious)) (when missing (patcher-files-string missing)))))) (defun patcher-detect-missing-change-logs (project) ;; Detect missing ChangLogs in PROJECT's process buffer diff. ;; Throw a change-logs-consistency error when detected. (multiple-value-bind (result spurious missing) (patcher-list= (patcher-change-logs (patcher-project-process-buffer project)) (patcher-project-change-logs project) :test #'string=) (assert (null spurious)) (unless result (patcher-error 'change-logs-consistency nil (when missing (patcher-files-string missing)))))) (defun* patcher-detect-spurious-change-logs (project change-logs &aux spurious) ;; Detect spurious CHANGE-LOGS in PROJECT's process buffer diff. ;; Throw a change-logs-consistency error when detected. (dolist (change-log change-logs) (when (patcher-extent 'change-log :value change-log :test #'string= :here (patcher-project-process-buffer project)) (patcher-endpush change-log spurious))) (when spurious (patcher-error 'change-logs-consistency (patcher-files-string spurious) nil))) (defun patcher-inconsistent-change-logs-description (spurious missing) ;; Return a string describing SPURIOUS and/or MISSING ChangeLogs. (concat "ChangeLogs inconsistency detected." (when spurious (format "\n The following ChangeLog files contain spurious entries: %s. Possible causes are: - your project is out of date (someone else has modified the ChangeLog files in the meantime. You should then update your project before running Patcher. - you have filled the ChangeLogs files manually, but Patcher is supposed to do so automatically. You need to either clean up the ChangeLog files, or set the :change-logs-updating project option to 'manual." spurious)) (when missing (format "\n The following ChangeLog files miss some entries: %s. Possible causes are: - the ChangeLog files have already been checked in by another instance of Patcher or anyone else. You should probably fix the last commit. - the ChangeLog entries are supposed to be written manually, but you forgot some of them. You need to either write them by hand, or set the :change-logs-updating project option to 'automatic." missing)))) (patcher-define-error 'undiffable-change-logs "Patcher undiffable ChangeLogs." 'change-log) (defun patcher-detect-ephemeral-change-logs (project) ;; Detect ephemeral ChangeLogs for PROJECT. ;; Throw an undiffable-change-logs when detected. (when (eq (patcher-project-option project :change-logs-status) 'ephemeral) (patcher-error 'undiffable-change-logs))) ;; ========================================================================== ;; ChangeLog Navigation ;; ========================================================================== ;; #### NOTE: in case the user decides to browse manual ChangeLog entries, we ;; need to make sure that the project/change-log extents exist. That's why we ;; call patcher-change-log-extent in the functions below. (defun patcher-switch-to-first-change-log (project) ;; Switch to the first PROJECT ChangeLog. (multiple-value-bind (buffer) (patcher-change-log-buffer project (car (patcher-project-change-logs project)) 'find) (switch-to-buffer buffer)) (patcher-change-log-extent project (current-buffer) 'create)) (defun patcher-switch-to-last-change-log (project) ;; Switch to the last PROJECT ChangeLog. (multiple-value-bind (buffer) (patcher-change-log-buffer project (car (last (patcher-project-change-logs project))) 'find) (switch-to-buffer buffer)) (patcher-change-log-extent project (current-buffer) 'create)) (defun patcher-switch-to-next-change-log (project) ;; Circularly switch to PROJECT's next ChangeLog or mail buffer. (switch-to-buffer (let* ((change-logs (patcher-project-change-logs project)) (from-file (buffer-file-name (current-buffer))) (tail (member from-file change-logs))) (assert tail) (if (cdr tail) (multiple-value-bind (buffer) (patcher-change-log-buffer project (cadr tail) 'find) buffer) (patcher-project-mail-buffer project)))) (patcher-change-log-extent project (current-buffer) 'create)) (defun patcher-switch-to-previous-change-log (project) ;; Circularly switch to PROJECT's previous ChangeLog or mail buffer. (switch-to-buffer (let* ((change-logs (patcher-project-change-logs project)) (from-file (buffer-file-name (current-buffer)))) (if (string= from-file (first change-logs)) (patcher-project-mail-buffer project) (do ((tail change-logs (cdr tail))) ((string= from-file (cadr tail)) (progn (assert tail) (multiple-value-bind (buffer) (patcher-change-log-buffer project (car tail) 'find) buffer))))))) (patcher-change-log-extent project (current-buffer) 'create)) ;; ========================================================================== ;; ChangeLog minor mode ;; ========================================================================== (defun* patcher-change-log-interactive (&aux (extent (extent-at (point) (current-buffer) 'patcher-project)) (project (when extent (extent-property extent 'patcher-project)))) ;; Find a project in the current ChangeLog buffer. ;; Prefer the project related to the ChangeLog entry at point. ;; Otherwise, use the first one found if it is the only one. ;; Otherwise, barf. (or (when project (list project)) (let ((projects (patcher-mapcar-change-log-extents (extent) (extent-property extent 'patcher-project)))) (if (= (length projects) 1) (list (first projects)) (patcher-error "\ Unable to determine project. Please move point to a relevant entry."))))) (defun patcher-change-log-change-subject (project) "Read a new subject for PROJECT. The new subject is propagated to all relevant buffers. PROJECT is determined by the ChangeLog entry at point if there is one. Otherwise, if the ChangeLog buffer is associated with a single project, it is used. Otherwise, it fails." (interactive (patcher-change-log-interactive)) (patcher-change-subject project)) (defun patcher-change-log-mail (project) "Switch to PROJECT's mail buffer. PROJECT is determined by the ChangeLog entry at point if there is one. Otherwise, if the ChangeLog buffer is associated with a single project, it is used. Otherwise, it fails." (interactive (patcher-change-log-interactive)) (switch-to-buffer (patcher-project-mail-buffer project))) (defun patcher-change-log-insert-change-logs (project) "Switch to PROJECT's mail buffer and insert ChangeLog entries. PROJECT is determined by the ChangeLog entry at point if there is one. Otherwise, if the ChangeLog buffer is associated with a single project, it is used. Otherwise, it fails." (interactive (patcher-change-log-interactive)) (switch-to-buffer (patcher-project-mail-buffer project)) (declare-fboundp (patcher-mail-insert-change-logs))) (defun patcher-change-log-first (project) "Switch to PROJECT's first ChangeLog buffer. PROJECT is determined by the ChangeLog entry at point if there is one. Otherwise, if the ChangeLog buffer is associated with a single project, it is used. Otherwise, it fails." (interactive (patcher-change-log-interactive)) (patcher-switch-to-first-change-log project)) (defun patcher-change-log-next (project) "Circularly switch to PROJECT's next ChangeLog or mail buffer. PROJECT is determined by the ChangeLog entry at point if there is one. Otherwise, if the ChangeLog buffer is associated with a single project, it is used. Otherwise, it fails." (interactive (patcher-change-log-interactive)) (patcher-switch-to-next-change-log project)) (defun patcher-change-log-last (project) "Switch to PROJECT's last ChangeLog buffer. PROJECT is determined by the ChangeLog entry at point if there is one. Otherwise, if the ChangeLog buffer is associated with a single project, it is used. Otherwise, it fails." (interactive (patcher-change-log-interactive)) (patcher-switch-to-last-change-log project)) (defun patcher-change-log-previous (project) "Circularly switch to PROJECT's previous ChangeLog or mail buffer. PROJECT is determined by the ChangeLog entry at point if there is one. Otherwise, if the ChangeLog buffer is associated with a single project, it is used. Otherwise, it fails." (interactive (patcher-change-log-interactive)) (patcher-switch-to-previous-change-log project)) (defun patcher-change-log-kill (project) "Kill PROJECT. PROJECT is determined by the ChangeLog entry at point if there is one. Otherwise, if the ChangeLog buffer is associated with a single project, it is used. Otherwise, it fails." (interactive (patcher-change-log-interactive)) (patcher-kill-project project)) (defcustom patcher-change-log-minor-mode-string " Patch" "*Patcher ChangeLog minor mode modeline string." :group 'patcher :type 'string) (defcustom patcher-change-log-minor-mode-hook nil "*Hooks to run after setting up Patcher ChangeLog minor mode." :group 'patcher :type 'hook) (defvar patcher-change-log-minor-mode-map (let ((map (make-sparse-keymap 'patcher-change-log-minor-mode-map))) (define-key map [(control c) (control p) S] 'patcher-change-log-change-subject) (define-key map [(control c) (control p) m] 'patcher-change-log-mail) (define-key map [(control c) (control p) l] 'patcher-change-log-insert-change-logs) (define-key map [(control c) (control p) P] 'patcher-change-log-first) (define-key map [(control c) (control p) n] 'patcher-change-log-next) (define-key map [(control c) (control p) N] 'patcher-change-log-last) (define-key map [(control c) (control p) p] 'patcher-change-log-previous) (define-key map [(control c) (control p) k] 'patcher-change-log-kill) (define-key map [(control c) (control p) v] 'patcher-version) map) ;; Patcher minor mode keymap. ) (make-variable-buffer-local (defvar patcher-change-log-minor-mode nil)) (defun patcher-change-log-minor-mode (&optional arg) "Toggles Patcher ChangeLog minor mode. This mode is set up automatically by Patcher. You're not supposed to use this, unless you know what you're doing. The Patcher ChangeLog minor mode provides the following commands: \\{patcher-change-log-minor-mode-map}" (interactive "*P") (let ((was-off (not patcher-change-log-minor-mode))) (setq patcher-change-log-minor-mode (if (null arg) was-off (> (prefix-numeric-value arg) 0))) (when (and patcher-change-log-minor-mode was-off) (run-hooks 'patcher-change-log-minor-mode-hook)))) (add-minor-mode 'patcher-change-log-minor-mode patcher-change-log-minor-mode-string patcher-change-log-minor-mode-map) ;; ========================================================================== ;; ChangeLog referencing ;; ========================================================================== ;; ChangeLog buffers ======================================================== (put 'patcher-reference-change-log 'lisp-indent-function 1) (defun patcher-reference-change-log (project change-log existing) ;; Add a reference to PROJECT in CHANGE-LOG buffer. ;; EXISTING means that the buffer was not loaded by Patcher, so it should be ;; protected with an initial t value in patcher-references. ;; This function also adds PROJECT's after-save-hook in the CHANGE-LOG ;; buffer when necessary. (when change-log (with-current-buffer change-log (when (and existing (null patcher-references)) (push t patcher-references)) (patcher-change-log-minor-mode t) (when (and (patcher-reference-buffer project change-log) (eq (patcher-project-option project :change-logs-updating) 'automatic)) (dolist (hook (patcher-project-option project :after-save-change-log-hook)) (add-hook 'after-save-hook (patcher-wrap-hook project hook) nil t)))))) (put 'patcher-unreference-change-log 'lisp-indent-function 1) (defun patcher-unreference-change-log (project change-log kill) ;; Remove the reference to PROJECT from CHANGE-lOG buffer. ;; If KILL and PROJECT was the last reference in the CHANGE-LOG buffer, ;; authorize Patcher to kill the CHANGE-LOG buffer. ;; This function also removes PROJECT's after-save-hook and the ChangeLog ;; minor mode from the CHANGE-LOG buffer when necessary. ;; Return t if CHANGE-LOG was killed. (when change-log (patcher-delete-extent (patcher-change-log-extent project change-log)) (with-current-buffer change-log (when (eq (patcher-project-option project :change-logs-updating) 'automatic) (dolist (hook (patcher-project-option project :after-save-change-log-hook)) ;; #### NOTE: we remove the after-save-hook before possibly killing ;; (hence saving) the buffer, because unreferencing a ChangeLog ;; means that we're done with the project. (remove-hook 'after-save-hook (patcher-wrap-hook project hook) t))) (multiple-value-bind (lastp killp) (patcher-unreference-buffer project change-log kill ;; #### NOTE: this FORCE-SAVE flag is here because there's ;; currently no way to kill an unsaved buffer without asking ;; confirmation (kill-buffer is a built-in function). Normally, I ;; would rather kill without saving here. (when (eq (patcher-project-option project :change-logs-status) 'ephemeral) 'force-save)) (when lastp ;; no harm done even if the buffer was killed. (patcher-change-log-minor-mode -1)) killp)))) (put 'patcher-change-log-buffer 'lisp-indent-function 2) (defun* patcher-change-log-buffer (project change-log &optional find) ;; Find a buffer visiting PROJECT's CHANGE-LOG. ;; Return 2 values: a buffer visiting CHANGE-LOG and a boolean indicating ;; whether CHANGE-LOG was already visited. If CHANGE-LOG is not visited, ;; return nil unless FIND, in which case force visiting. ;; This function also references PROJECT in the buffer. (multiple-value-bind (buffer existing) (patcher-file-buffer change-log find) (patcher-reference-change-log project buffer existing) (values buffer existing))) (put 'patcher-change-log-buffers 'lisp-indent-function 1) (defun* patcher-change-log-buffers (project &optional find &aux buffers) ;; Return a list of buffers visiting PROJECT's ChangeLog files. ;; If FIND, make sure to visit all ChangeLog files. Otherwise, skip ;; unvisited ones. ;; This function also references PROJECT in each ChangeLog buffer. (dolist (change-log (patcher-project-change-logs project) buffers) (multiple-value-bind (buffer) (patcher-change-log-buffer project change-log find) (when buffer (patcher-endpush buffer buffers))))) (defun patcher-save-change-logs (project) ;; Save PROJECT's ChangeLog buffers (unless ephemeral). (unless (eq (patcher-project-option project :change-logs-status) 'ephemeral) (patcher-save-buffers (patcher-change-log-buffers project)))) ;; ChangeLog files ========================================================== (globally-declare-boundp 'patcher-link-change-log-hook) (put 'patcher-link-change-log 'lisp-indent-function 1) (defun patcher-link-change-log (project change-log) ;; Link CHANGE-LOG to PROJECT. ;; This function handles buffer reference if CHANGE-lOG is already loaded, ;; but doesn't load it otherwise. (unless (member change-log (patcher-project-change-logs project)) (patcher-endpush change-log (patcher-project-change-logs project)) (patcher-reference-change-log project (get-file-buffer change-log) 'existing) (patcher-with-progression "Running the link-change-log hook" (let ((patcher-link-change-log-hook (patcher-project-option project :link-change-log-hook))) (run-hook-with-args 'patcher-link-change-log-hook (patcher-file-relative-name change-log)))))) (defun patcher-link-change-logs (project change-logs) ;; Link CHANGE-LOGS to PROJECT. (dolist (change-log change-logs) (patcher-link-change-log project change-log))) (defun* patcher-unlink-change-log (project change-log override-kill &aux (kill (or override-kill (patcher-project-option project :kill-change-logs-after-sending)))) ;; Unlink CHANGE-LOG from PROJECT. ;; If OVERRIDE-KILL, override the :kill-change-logs-after-sending option. ;; If PROJECT has ephemeral ChangeLogs and the ChangeLog buffer was killed, ;; also delete the file. (when (member change-log (patcher-project-change-logs project)) (when (and (patcher-unreference-change-log project (get-file-buffer change-log) kill) (eq (patcher-project-option project :change-logs-status) 'ephemeral)) ;; ChangeLog files may in fact not exist if they are both ephemeral and ;; not saved. (condition-case nil (delete-file change-log) (file-error nil))) (setf (patcher-project-change-logs project) (delete change-log (patcher-project-change-logs project))))) (put 'patcher-unlink-change-logs 'lisp-indent-function 1) (defun* patcher-unlink-change-logs (project &key (change-logs (patcher-project-change-logs project)) override-kill &aux (kill (or override-kill (patcher-project-option project :kill-change-logs-after-sending)))) ;; Unlink CHANGE-LOGS from PROJECT. ;; If OVERRIDE-KILL, override the :kill-change-logs-after-sending option. (dolist (change-log change-logs) (patcher-unlink-change-log project change-log kill))) ;; ========================================================================== ;; ChangeLog entries in ChangeLog files ;; ========================================================================== (put 'patcher-change-log-extent 'lisp-indent-function 1) (defun* patcher-change-log-extent (project change-log &optional create &aux (extent (patcher-extent 'project :value project :here change-log))) ;; Return a ChangeLog extent for PROJECT in CHANGE-LOG. ;; Maybe CREATE one instead of returning nil. (when (and (not extent) create) (save-window-excursion (display-buffer change-log t) (let ((entries (patcher-read-natnum "\ How many entries belong to the project (1): " 1)) beg end) (when (> entries 0) (save-excursion (set-buffer change-log) (save-restriction (widen) (goto-char (point-min)) (skip-chars-forward " \n\t") (unless (looking-at +patcher-change-log-entry-start-regexp+) (patcher-error "\ Beginning of buffer doesn't look like a ChangeLog entry.")) (setq beg (point)) (condition-case nil (while (> entries 0) (re-search-forward +patcher-change-log-entry-start-regexp+) (setq entries (1- entries))) (t (patcher-error "\ Buffer is missing %s ChangeLog entr%s to do the count." entries (if (= entries 1) "y" "ies")))) (setq end (or (when (re-search-forward +patcher-change-log-entry-start-regexp+ nil t) (progn (beginning-of-line) (point))) (point-max))) (set-extent-properties (setq extent (make-extent beg end)) `(start-open t duplicable t patcher-project ,project patcher-change-log (buffer-file-name))))))))) extent) (put 'patcher-generate-change-logs 'lisp-indent-function 1) (defun* patcher-generate-change-logs (project &aux (buffer (patcher-project-process-buffer project))) ;; Generate PROJECT's ChangeLog skeletons. ;; These skeletons are based on the current process buffer's diff. ;; #### NOTE: if we let patch-to-change-log visit the files as needed, we ;; won't know which ones were already there, hence messing up with the ;; referencing. So instead, we start by loading them explicitely. (patcher-with-progression "Loading the source files" (patcher-source-buffers project 'find)) (patcher-with-progression "Loading the ChangeLog files" (patcher-change-log-buffers project 'find)) (patcher-with-progression "Generating the ChangeLog skeletons" (with-current-buffer buffer ;; #### NOTE: before version 3.11, every diff output was cleaned up by ;; after-diff hooks to remove (some of the) RCS specific syntax. This ;; isn't the case anymore so in order for patch-to-change-log to keep on ;; working, we need to do this cleanup here. (let ((diff-cleaner (patcher-project-option project :diff-cleaner)) (string (patcher-source-contents buffer))) (with-string-as-buffer-contents string (require 'add-log) (beginning-of-buffer) (when diff-cleaner (funcall diff-cleaner (patcher-project-option project :diff-header t))) ;; #### WARNING: temporary hack to let patch-to-change-log use my ;; own ChangeLog locating function. Note the free reference to ;; ABSFILE. I will eventually provide my own version of this ;; function. (flet ((find-change-log () (patcher-locate-change-log project (declare-boundp absfile)))) (patch-to-change-log (patcher-project-command-directory project) :my-name (or (patcher-project-option project :change-logs-user-name) (patcher-project-option project :user-name)) :my-email (or (patcher-project-option project :change-logs-user-mail) (patcher-project-option project :user-mail)) :extent-property 'patcher-project :extent-property-value project))))) ;; Now that we have our ChangeLog skeletons, let's loop over them and add ;; the patcher-change-log property to the extents. ;; #### NOTE: the part about burying in the comment below is obsolete ;; because we now have proper navigation commands. ;; Also, patch-to-change-log has the unfortunate side effect of burying ;; all the ChangeLog buffers when it's done. This is exactly the opposite ;; of what we want, since once the ChangeLogs have been generated, the ;; next step is to go visit them. so put them (in order!) directly below ;; the current buffer, and while we're at it, also add the ;; patcher-change-log property to every extent. (let ((topbuf (car (buffer-list)))) (dolist (clbuf (patcher-change-log-buffers project)) (bury-buffer clbuf topbuf) (let ((extent (patcher-change-log-extent project clbuf))) (assert extent) (set-extent-properties extent `(start-open t duplicable t patcher-change-log ,(buffer-file-name clbuf))) (with-current-buffer clbuf ;; window-start ends up past the newly inserted entry, so fix that. (goto-char (extent-start-position extent))))) (bury-buffer topbuf (car (buffer-list)))))) (put 'patcher-ungenerate-change-log 'lisp-indent-function 2) (defun patcher-ungenerate-change-log (project change-log interactive prompt) ;; Remove PROJECT's previously generated ChangeLog entries in CHANGE-LOG. ;; If INTERACTIVE, ask confirmation. (when change-log (let ((extent (patcher-change-log-extent project change-log))) (when (and extent (or (not interactive) (progn (display-buffer change-log) (y-or-n-p prompt)))) (patcher-delete-extent-and-region extent))) ;; Always offer to save the buffer now (even if nothing really happened), ;; because ungeneration is often followed by a diff, and the question ;; would be asked anyway, only later. Doing it here is better because the ;; buffer might already be displayed. (unless (eq (patcher-project-option project :change-logs-status) 'ephemeral) (patcher-save-buffer change-log)))) (put 'patcher-ungenerate-change-logs 'lisp-indent-function 1) (defun* patcher-ungenerate-change-logs (project change-logs &key interactive (prompt "Remove this skeleton? ")) ;; Remove PROJECT's previously generated ChangeLog entries. ;; If INTERACTIVE, ask confirmation for each ChangeLog buffer with PROMPT. ;; Perform on CHANGE-LOGS (all PROJECT's ChangeLog buffers by default). (save-window-excursion (dolist (change-log change-logs) (patcher-ungenerate-change-log project change-log interactive prompt)))) (defun* patcher-generated-change-logs (project &aux change-log-buffers) ;; Return a list of generated ChangeLog buffers for PROJECT. (when (eq (patcher-project-option patcher-project :change-logs-updating) 'automatic) (dolist (change-log-buffer (patcher-change-log-buffers project)) (when (patcher-change-log-extent project change-log-buffer) (patcher-endpush change-log-buffer change-log-buffers)))) change-log-buffers) ;; ========================================================================== ;; ChangeLog entries outside ChangeLog files ;; ========================================================================== (put 'patcher-compress-change-logs 'lisp-indent-function 1) (defun patcher-compress-change-logs () ;; Compress ChangeLog entries in the patcher-change-logs extent. ;; Make it a 'patcher-compressed-change-logs extent afterwards. ;; #### WARNING: this will break if someone wants BOTH ChangeLogs and ;; compressed ChangeLogs. (patcher-within-extent (extent 'change-logs) (narrow-to-region (extent-start-position extent) (extent-end-position extent)) (patcher-delete-extent-and-region (patcher-extent 'change-log-prologue)) (delete-matching-lines +patcher-change-log-entry-start-regexp+) ;; Now compress the change log specs into just files, so that mostly just ;; the annotations are left. (let ((change-log-change-line "^\\([ \t]+\\)\\* \\(\\S-+\\)\\( (.*)\\)?:\\( New\\.\\)?")) (while (re-search-forward change-log-change-line nil t) ;; Change to match-end if you want the indentation. (let ((beg (match-beginning 1)) (end (match-end 0)) files) (push (match-string 2) files) (forward-line 1) (while (looking-at change-log-change-line) (setq end (match-end 0)) (unless (member (match-string 2) files) (push (match-string 2) files)) (forward-line 1)) (goto-char beg) (delete-region beg end) (insert (mapconcat #'identity (nreverse files) ", ") ":") (when (looking-at "\\s-+") (let ((p (point)) (end (match-end 0))) ;; If there's no annotation at all for this change, make sure ;; we don't treat the next change as an annotation for this ;; one! (if (save-excursion (goto-char end) (beginning-of-line) (looking-at change-log-change-line)) (progn (if (looking-at "[ \t]+") (delete-region p (match-end 0)))) (delete-region p end) (insert " "))))))) ;; Shrink extra blank lines. (let ((blank-line "^\\s-*$")) (goto-char (point-min)) (while (and (not (eobp)) (progn (forward-line 1) (re-search-forward blank-line nil t))) (delete-blank-lines)) (goto-char (point-min)) (if (looking-at blank-line) (delete-blank-lines))) (widen) (set-extent-properties extent '(patcher-change-logs nil patcher-compressed-change-logs t)))) ;; This function is used in patcher-mail and patcher-logmsg. ChangeLog ;; contents means ChangeLog entries, possibly prepended by a ChangeLog ;; prologue. (defun* patcher-insert-change-log-contents (project point &aux (prologue (patcher-project-option project :change-logs-prologue))) ;; Insert PROJECT's ChangeLog contents in current buffer at POINT. ;; Create the patcher-change-logs extent. ;; Return t if something has indeed been inserted. (patcher-with-progression "Inserting ChangeLog contents" (save-excursion (goto-char point) (dolist (change-log (patcher-change-log-buffers project 'find)) (insert "\n") (unless (zerop (length prologue)) (let ((beg (point))) (insert (replace-in-string prologue "%f" (patcher-file-relative-name (buffer-file-name change-log))) "\n\n") (set-extent-properties (make-extent beg (point)) `(start-open t duplicable t patcher-change-log-prologue ,(buffer-file-name change-log))))) (insert (extent-string (patcher-change-log-extent project change-log 'create)))) (set-extent-properties (make-extent point (point)) '(start-open t duplicable t patcher-change-logs t)) (not (= (point) point))))) (provide 'patcher-change-log) ;;; patcher-change-log.el ends here