| 29 |
|
|
| 30 |
;; Contents management by FCM version 0.1. |
;; Contents management by FCM version 0.1. |
| 31 |
|
|
| 32 |
;; Many thanks to Ben Wing <ben@xemcas.org> for good ideas and code. |
;; Many thanks to Ben Wing <ben@xemacs.org> for good ideas and code. |
| 33 |
|
|
| 34 |
;; This package automates the process of building and submitting patches for |
;; This package automates the process of building and submitting patches for |
| 35 |
;; archive-based projects you're working on. In one or two keystrokes, it |
;; archive-based projects you're working on. In one or two keystrokes, it |
| 36 |
;; prepares a mail with a patch corresponding to the differences between your |
;; prepares a mail with a patch corresponding to the differences between your |
| 37 |
;; working version and the archive state, and prepares a skeleton for the |
;; working version and the archive state, and prepares a skeleton for the |
| 38 |
;; ChangeLog entries, that you can fill in and insert into the message before |
;; ChangeLog entries, that you can fill in and insert into the message before |
| 39 |
;; sending. |
;; sending. You also have the possibility of committing your changes directly |
| 40 |
|
;; from your XEmacs session. |
| 41 |
|
|
| 42 |
;; Patcher currently supports the `compose-mail' mail sending interface, as |
;; Patcher currently supports the `compose-mail' mail sending interface, as |
| 43 |
;; well as the `sendmail' and `message' libraries individually, which is |
;; well as the `sendmail' and `message' libraries individually, which is |
| 55 |
;; commit) changes to particular directories and/or files in the project. |
;; commit) changes to particular directories and/or files in the project. |
| 56 |
;; 2/ Edit the different ChangeLog buffers that have opened, and fill in the |
;; 2/ Edit the different ChangeLog buffers that have opened, and fill in the |
| 57 |
;; skeletons. You can save the ChangeLogs buffers, BUT DON't KILL THEM !! |
;; skeletons. You can save the ChangeLogs buffers, BUT DON't KILL THEM !! |
| 58 |
;; 3/ If you want to commit your changes immediately, type C-c C-p c. You'll |
;; 3/ If you want to commit your changes immediately, type `C-c C-p c' in |
| 59 |
;; have the opportunity to edit the message log and commit your changes. |
;; the message buffer. You'll have the opportunity to edit the message log |
| 60 |
|
;; and/or the commit command, and finally commit your changes. |
| 61 |
;; 4/ Otherwise, or just after that, type `C-c C-p i' in the message buffer. |
;; 4/ Otherwise, or just after that, type `C-c C-p i' in the message buffer. |
| 62 |
;; The new ChangeLog entries will be inserted just above the patch. Then, |
;; The new ChangeLog entries will be inserted just above the patch. |
| 63 |
;; send it. |
;; 5/ At any time after step 1, you can change your mind (like further modify |
| 64 |
;; 5/ That's all folks. |
;; source files) and regenerate the diff again. To do that, just type |
| 65 |
|
;; `C-c C-p d' in the message buffer. If ChangeLog skeletons had already |
| 66 |
|
;; been created, and possibly edited, you'll be asked whether you want to |
| 67 |
|
;; regenerate them also. The diff regeneration feature is also usefull when |
| 68 |
|
;; the initial diff command failed for some reason. |
| 69 |
|
;; 6/ That's all folks. You can send the message. |
| 70 |
|
|
| 71 |
;; Requirements: |
;; Requirements: |
| 72 |
|
|
| 118 |
;;; Code: |
;;; Code: |
| 119 |
|
|
| 120 |
(require 'add-log) |
(require 'add-log) |
| 121 |
|
;; Require 'sendmail for getting `mail-header-separator'. |
| 122 |
|
;; #### Now that a fake mail sending function exists, sendmail shoudn't be |
| 123 |
|
;; systematically required like this. However, since most users will really |
| 124 |
|
;; want do send real messasges, it probably doesn't hurt to keep things like |
| 125 |
|
;; this. |
| 126 |
(require 'sendmail) |
(require 'sendmail) |
| 127 |
|
|
| 128 |
(defgroup patcher nil |
(defgroup patcher nil |
| 129 |
"Patch mailing utilities.") |
"Patch mailing utilities.") |
| 130 |
|
|
| 131 |
|
(defmacro patcher-globally-declare-fboundp (symbol) |
| 132 |
|
;; copied from bytecomp-runtime.el |
| 133 |
|
(when (cl-compiling-file) |
| 134 |
|
(setq symbol (eval symbol)) |
| 135 |
|
(if (not (consp symbol)) |
| 136 |
|
(setq symbol (list symbol))) |
| 137 |
|
;; Another hack. This works because the autoload environment is |
| 138 |
|
;; currently used ONLY to suppress warnings, and the actual |
| 139 |
|
;; autoload definition is not used. (NOTE: With this definition, |
| 140 |
|
;; we will get spurious "multiple autoloads for %s" warnings if we |
| 141 |
|
;; have an autoload later in the file for any functions in SYMBOL. |
| 142 |
|
;; This is not something that code should ever do, though.) |
| 143 |
|
(setq byte-compile-autoload-environment |
| 144 |
|
(append (mapcar #'(lambda (sym) (cons sym nil)) symbol) |
| 145 |
|
byte-compile-autoload-environment))) |
| 146 |
|
nil) |
| 147 |
|
|
| 148 |
|
(patcher-globally-declare-fboundp |
| 149 |
|
'(gnus-alive-p gnus-post-news message-goto-subject message-goto-body)) |
| 150 |
|
|
| 151 |
|
|
| 152 |
;; Projects description ===================================================== |
;; Projects description ===================================================== |
| 153 |
|
|
| 156 |
:group 'patcher) |
:group 'patcher) |
| 157 |
|
|
| 158 |
(defcustom patcher-default-mail-method 'compose-mail |
(defcustom patcher-default-mail-method 'compose-mail |
| 159 |
"*Default method used by Patcher to prepare a mail (a symbol). |
"*Default method used by Patcher to prepare a mail \(a symbol). |
| 160 |
Currently, there are four built-in methods: 'compose-mail \(the default), |
Currently, there are four built-in methods: 'compose-mail \(the default), |
| 161 |
'sendmail, 'message, 'gnus and 'fake. Please refer to the corresponding |
'sendmail, 'message, 'gnus and 'fake. Please refer to the corresponding |
| 162 |
`patcher-mail-*' function for a description of each method. You can also |
`patcher-mail-*' function for a description of each method. You can also |
| 166 |
function must prepare a mail buffer. If you want to do this, please see |
function must prepare a mail buffer. If you want to do this, please see |
| 167 |
how it's done for the built-in methods." |
how it's done for the built-in methods." |
| 168 |
:group 'patcher-default |
:group 'patcher-default |
| 169 |
:type '(choice (const :value compose-mail) |
:type '(radio (const :value compose-mail) |
| 170 |
(const :value sendmail) |
(const :value sendmail) |
| 171 |
(const :value message) |
(const :value message) |
| 172 |
(const :value gnus) |
(const :value gnus) |
| 173 |
(const :value fake) |
(const :value fake) |
| 174 |
(symbol :tag "other"))) |
(symbol :tag "other"))) |
| 175 |
|
|
| 176 |
|
(defcustom patcher-default-subject "" |
| 177 |
|
"*Default subject to use when sending a Patcher mail \(a string). |
| 178 |
|
A %n occurring in this string will be replaced by the project's name. |
| 179 |
|
All subjects are unconditionally prefixed with the string \"[PATCH] \"." |
| 180 |
|
:group 'patcher-default |
| 181 |
|
:type 'string) |
| 182 |
|
|
| 183 |
|
(defcustom patcher-default-mail-prologue "" |
| 184 |
|
"*Default string to insert at the beginning of every Patcher mail." |
| 185 |
|
:group 'patcher-default |
| 186 |
|
:type 'string) |
| 187 |
|
|
| 188 |
(defcustom patcher-default-diff-command "cvs -q diff -u %f" |
(defcustom patcher-default-diff-command "cvs -q diff -u %f" |
| 189 |
"*Default method used by Patcher to generate a patch \(a string). |
"*Default method used by Patcher to generate a patch \(a string). |
| 190 |
A %f occurring in this string will be replaced by the files affected by |
A %f occurring in this string will be replaced by the files affected by |
| 194 |
:group 'patcher-default |
:group 'patcher-default |
| 195 |
:type 'string) |
:type 'string) |
| 196 |
|
|
| 197 |
|
(defcustom patcher-default-diff-prologue "%n Patch (%c):" |
| 198 |
|
"*Default string to insert just before the patch in every Patcher mails. |
| 199 |
|
A %n occurring in this string will be replaced with the project's name. |
| 200 |
|
A %c occurring in this string will be replaced with the diff command." |
| 201 |
|
:group 'patcher-default |
| 202 |
|
:type 'string) |
| 203 |
|
|
| 204 |
(defcustom patcher-default-commit-command "cvs commit -F %s %f" |
(defcustom patcher-default-commit-command "cvs commit -F %s %f" |
| 205 |
"*Default method used by Patcher to commit a patch \(a string). |
"*Default method used by Patcher to commit a patch \(a string). |
| 206 |
This command must contain a %s which will be replaced with the name of a |
This command must contain a %s which will be replaced with the name of a |
| 219 |
|
|
| 220 |
(defcustom patcher-default-committed-notice |
(defcustom patcher-default-committed-notice |
| 221 |
"NOTE: This patch has been committed." |
"NOTE: This patch has been committed." |
| 222 |
"*Notice added to a Patcher mail when the patch is committed before sending." |
"*Notice added to a mail when the patch is committed before sending." |
| 223 |
:group 'patcher-default |
:group 'patcher-default |
| 224 |
:type 'string) |
:type 'string) |
| 225 |
|
|
| 226 |
|
(defcustom patcher-default-failed-command-regexp "^cvs \\[[^]]* aborted\\]" |
| 227 |
|
"*Default regular expression for matching the result of a failed command. |
| 228 |
|
Commands in question are the diff and the commit one." |
| 229 |
|
:group 'patcher-default |
| 230 |
|
:type 'regexp) |
| 231 |
|
|
| 232 |
(defcustom patcher-default-init-log-message 'subject |
(defcustom patcher-default-init-log-message 'subject |
| 233 |
"*How to initialize the commit log message \(a symbol). |
"*How to initialize the commit log message \(a symbol). |
| 234 |
The values currently supported are: |
The values currently supported are: |
| 235 |
- 'subject (the default): use the subject of the mail. |
- 'subject \(the default): use the subject of the mail. |
| 236 |
- 'change-logs: use the ChangeLog entries. |
- 'change-logs: use the ChangeLog entries. |
| 237 |
|
- 'compressed-change-logs: use the ChangeLog entries, but compress them |
| 238 |
|
into something more suitable as a log message. |
| 239 |
|
- 'compressed-change-logs-with-original: insert the compressed ChangeLog |
| 240 |
|
entries, as above, but also append the original entries at the end for |
| 241 |
|
easy reference. You should delete the originals before committing. |
| 242 |
- nil: don't initialize the log message. |
- nil: don't initialize the log message. |
| 243 |
|
|
| 244 |
If at commit time, the log message is empty, \"(none)\" will be used." |
If at commit time, the log message is empty, \"\(none)\" will be used." |
| 245 |
:group 'patcher-default |
:group 'patcher-default |
| 246 |
:type '(choice (const :value subject) |
:type '(radio (const :value subject) |
| 247 |
(const :value change-logs) |
(const :value change-logs) |
| 248 |
|
(const :value compressed-change-logs) |
| 249 |
|
(const :value compressed-change-logs-with-original) |
| 250 |
(const :value nil :tag "nothing"))) |
(const :value nil :tag "nothing"))) |
| 251 |
|
|
| 252 |
(defcustom patcher-default-edit-log-message t |
(defcustom patcher-default-edit-log-message t |
| 256 |
:group 'patcher-default |
:group 'patcher-default |
| 257 |
:type 'boolean) |
:type 'boolean) |
| 258 |
|
|
|
(defcustom patcher-default-mail-prologue "" |
|
|
"*A string to insert at the beginning of every Patcher mail." |
|
|
:group 'patcher-default |
|
|
:type 'string) |
|
|
|
|
| 259 |
(defcustom patcher-default-kill-source-files-after-sending t |
(defcustom patcher-default-kill-source-files-after-sending t |
| 260 |
"*Whether to kill source files after sending the mail. |
"*Whether to kill source files after sending the mail. |
| 261 |
This is effective only when sources files have not been killed already (see |
This is effective only when sources files have not been killed already |
| 262 |
the variable `patcher-default-kill-source-files-after-diffing'). |
\(see the variable `patcher-default-kill-source-files-after-diffing'). |
| 263 |
|
|
| 264 |
That feature is not implemented yet." |
That feature is not implemented yet." |
| 265 |
:group 'patcher-default |
:group 'patcher-default |
| 279 |
:group 'patcher-default |
:group 'patcher-default |
| 280 |
:type 'boolean) |
:type 'boolean) |
| 281 |
|
|
|
(defconst patcher-default-inheritance nil |
|
|
;; Defining this const avoids coding a special case for the :inheritance |
|
|
;; project option in the accessor functions. |
|
|
) |
|
|
|
|
| 282 |
(defcustom patcher-default-to-address "xemacs-patches@xemacs.org" |
(defcustom patcher-default-to-address "xemacs-patches@xemacs.org" |
| 283 |
"*Default email address to use when sending a Patcher mail (a string). |
"*Default email address to use when sending a Patcher mail (a string). |
| 284 |
This variable is used by all mail methods except the 'gnus one \(see |
This variable is used by all mail methods except the 'gnus one \(see |
| 295 |
:group 'patcher-default |
:group 'patcher-default |
| 296 |
:type 'string) |
:type 'string) |
| 297 |
|
|
| 298 |
(defcustom patcher-projects '() |
;; Defining these const avoids coding special cases for the :inheritance, |
| 299 |
"*List of project descriptors used by `patcher-mail'. |
;; :subdirectory and :files (sub)project option in the accessor functions. |
| 300 |
Each project descriptor looks like (NAME DIR OPTIONS...): |
(defconst patcher-default-inheritance nil) |
| 301 |
- NAME is the project's name (it serves to identify the project), |
(defconst patcher-default-subdirectory nil) |
| 302 |
- DIR is the top level directory where the project's sources live, |
(defconst patcher-default-files nil) |
|
|
|
|
The remainder of the project descriptor is composed of \"project options\" |
|
|
\(keywords and associated values). Keywords correspond to the variables |
|
|
`patcher-default-*'. When Patcher needs a keyword value, it tries to find |
|
|
at different places: |
|
|
- first, it looks for the keyword in the project options. |
|
|
- if that fails, it tries to find it in the project options of the projects |
|
|
appearing in the `:inheritance' option of the current project. |
|
|
- if that fails, it falls back to the corresponding `patcher-default-*' |
|
|
variable. |
|
| 303 |
|
|
| 304 |
As an exception, the `:inheritance' keyword does not have a corresponding |
(defconst patcher-project-options-custom-type |
| 305 |
`patcher-default-inheritance' variable." |
'((list :inline t :tag "Mail method" |
|
:group 'patcher |
|
|
:type '(repeat |
|
|
(group (string :tag "Project") |
|
|
(directory :tag "Project directory") |
|
|
(repeat :inline t :tag "Options" |
|
|
(choice :inline t :value (:mail-method compose-mail) |
|
|
(list :inline t :tag "Mail method" |
|
| 306 |
:format "%{%t%}: %v" |
:format "%{%t%}: %v" |
| 307 |
(const :tag "" :value :mail-method) |
(const :tag "" :value :mail-method) |
| 308 |
(choice (const :value compose-mail) |
(choice (const :value compose-mail) |
| 311 |
(const :value gnus) |
(const :value gnus) |
| 312 |
(const :value fake) |
(const :value fake) |
| 313 |
(symbol :tag "other"))) |
(symbol :tag "other"))) |
| 314 |
|
(list :inline t :tag "Subject" |
| 315 |
|
:format "%{%t%}: %v" |
| 316 |
|
(const :tag "" :value :subject) |
| 317 |
|
(string :tag "Value")) |
| 318 |
|
(list :inline t :tag "Mail Prologue" |
| 319 |
|
:format "%{%t%}: %v" |
| 320 |
|
(const :tag "" :value :mail-prologue) |
| 321 |
|
(string :tag "Value")) |
| 322 |
(list :inline t :tag "Diff command" |
(list :inline t :tag "Diff command" |
| 323 |
:format "%{%t%}: %v" |
:format "%{%t%}: %v" |
| 324 |
(const :tag "" :value :diff-command) |
(const :tag "" :value :diff-command) |
| 325 |
(string :tag "Value")) |
(string :tag "Value")) |
| 326 |
|
(list :inline t :tag "Diff prologue" |
| 327 |
|
:format "%{%t%}: %v" |
| 328 |
|
(const :tag "" :value :diff-prologue) |
| 329 |
|
(string :tag "Value")) |
| 330 |
(list :inline t :tag "Commit command" |
(list :inline t :tag "Commit command" |
| 331 |
:format "%{%t%}: %v" |
:format "%{%t%}: %v" |
| 332 |
(const :tag "" :value :commit-command) |
(const :tag "" :value :commit-command) |
| 339 |
:format "%{%t%}: %v" |
:format "%{%t%}: %v" |
| 340 |
(const :tag "" :value :committed-notice) |
(const :tag "" :value :committed-notice) |
| 341 |
(string :tag "Value")) |
(string :tag "Value")) |
| 342 |
|
(list :inline t :tag "Failed command regexp" |
| 343 |
|
:format "%{%t%}: %v" |
| 344 |
|
(const :tag "" :value :failed-command-regexp) |
| 345 |
|
(regexp :tag "Value")) |
| 346 |
(list :inline t :tag "Init log message" |
(list :inline t :tag "Init log message" |
| 347 |
:format "%{%t%}: %v" |
:format "%{%t%}: %v" |
| 348 |
(const :tag "" :value :init-log-message) |
(const :tag "" :value :init-log-message) |
| 349 |
(choice (const :value subject) |
(choice (const :value subject) |
| 350 |
(const :value change-logs))) |
(const :value change-logs) |
| 351 |
|
(const :value compressed-change-logs) |
| 352 |
|
(const :value compressed-change-logs-with-original))) |
| 353 |
(list :inline t :tag "Edit log message" |
(list :inline t :tag "Edit log message" |
| 354 |
:format "%{%t%}: %v" |
:format "%{%t%}: %v" |
| 355 |
(const :tag "" :value :edit-log-message) |
(const :tag "" :value :edit-log-message) |
| 356 |
(boolean :tag "Value")) |
(boolean :tag "Value")) |
|
(list :inline t :tag "Mail Prologue" |
|
|
:format "%{%t%}: %v" |
|
|
(const :tag "" :value :mail-prologue) |
|
|
(string :tag "Value")) |
|
| 357 |
(list :inline t |
(list :inline t |
| 358 |
:tag "Kill source files after sending" |
:tag "Kill source files after sending" |
| 359 |
:format "%{%t%}: %v" |
:format "%{%t%}: %v" |
| 383 |
:format "%{%t%}: %v" |
:format "%{%t%}: %v" |
| 384 |
(const :tag "" :value :gnus-group) |
(const :tag "" :value :gnus-group) |
| 385 |
(string :tag "Value")) |
(string :tag "Value")) |
| 386 |
|
(list :inline t :tag "Other" |
| 387 |
|
symbol |
| 388 |
|
sexp)) |
| 389 |
|
;; Custom type elements for Patcher project options common to |
| 390 |
|
;; `patcher-projects' and `patcher-subprojects'. |
| 391 |
|
) |
| 392 |
|
|
| 393 |
|
(defcustom patcher-projects '() |
| 394 |
|
"*List of project descriptors used by `patcher-mail'. |
| 395 |
|
Each project descriptor looks like \(NAME DIR OPTIONS...): |
| 396 |
|
- NAME is the project's name \(it serves to identify the project), |
| 397 |
|
- DIR is the top level directory where the project's sources live, |
| 398 |
|
|
| 399 |
|
The remainder of the project descriptor is composed of \"project options\" |
| 400 |
|
\(keywords and associated values). Keywords correspond to the variables |
| 401 |
|
`patcher-default-*'. When Patcher needs a keyword value, it tries to find |
| 402 |
|
at different places: |
| 403 |
|
- first, it looks for the keyword in the project options. |
| 404 |
|
- if that fails, it tries to find it in the project options of the projects |
| 405 |
|
appearing in the `:inheritance' option of the current project. |
| 406 |
|
- if that fails, it falls back to the corresponding `patcher-default-*' |
| 407 |
|
variable. |
| 408 |
|
|
| 409 |
|
As an exception, the `:inheritance' keyword does not have a corresponding |
| 410 |
|
`patcher-default-inheritance' variable." |
| 411 |
|
:group 'patcher |
| 412 |
|
:type `(repeat |
| 413 |
|
(group (string :tag "Project") |
| 414 |
|
(directory :tag "Project directory") |
| 415 |
|
(repeat :inline t :tag "Options" |
| 416 |
|
(choice :inline t :value (:mail-method compose-mail) |
| 417 |
|
,@patcher-project-options-custom-type |
| 418 |
(list :inline t :tag "Inheritance" |
(list :inline t :tag "Inheritance" |
| 419 |
:format "%{%t%}: %v" |
:format "%{%t%}: %v" |
| 420 |
(const :tag "" :value :inheritance) |
(const :tag "" :value :inheritance) |
| 421 |
(repeat :tag "From" |
(repeat :tag "From" |
| 422 |
(string :tag "Project"))) |
(string :tag "Project"))))) |
| 423 |
(list :inline t :tag "Other" |
)) |
|
symbol |
|
|
sexp)) |
|
|
))) |
|
| 424 |
) |
) |
| 425 |
|
|
| 426 |
|
(defcustom patcher-subprojects '() |
| 427 |
|
"*List of subproject descriptors used by `patcher-mail'. |
| 428 |
|
Subproject descriptors are similar to project descriptors \(see the |
| 429 |
|
variable `patcher-projects') with a few exceptions: |
| 430 |
|
|
| 431 |
|
- instead of the project directory field DIR, you specify the name of the |
| 432 |
|
project this subproject is based on. |
| 433 |
|
- two project options are available in addition to the standard ones: |
| 434 |
|
- :subdirectory lets you specify a subdirectory \(of the original |
| 435 |
|
project's directory) in which the whole subproject resides. There is |
| 436 |
|
no corresponding `patcher-default-subdirectory' variable. |
| 437 |
|
- :files lets you specify a list of files or directories composing the |
| 438 |
|
subproject. Each file specification can contain wildcards. If a |
| 439 |
|
:subdirectory option is given, these files or directories should be |
| 440 |
|
relative to this subdirectory. Otherwise, they should be relative to |
| 441 |
|
the base project's directory. There is no corresponding |
| 442 |
|
`patcher-default-files' variable. |
| 443 |
|
Note that a subproject with neither a :subdirectory nor a :files option |
| 444 |
|
behaves exactly like the corresponding base project. |
| 445 |
|
- subprojects don't have an :inheritance mechanism. Instead, they |
| 446 |
|
implicitly inherit from their base project \(which in turn can inherit |
| 447 |
|
from other projects). |
| 448 |
|
|
| 449 |
|
Note: the normal way to use predefined Patcher subprojects is to call |
| 450 |
|
`patcher-mail', *not* `patcher-mail-subproject'. Using the former will |
| 451 |
|
directly use the set of files and/or directory you have specified. Using |
| 452 |
|
the latter will also let you modify this set." |
| 453 |
|
:group 'patcher |
| 454 |
|
:type `(repeat |
| 455 |
|
(group (string :tag "Subproject") |
| 456 |
|
(string :tag "Of project") |
| 457 |
|
(repeat :inline t :tag "Options" |
| 458 |
|
(choice :inline t :value (:subdirectory "") |
| 459 |
|
;; #### Look inside the widget library to see |
| 460 |
|
;; how we can modify the completion behavior |
| 461 |
|
(list :inline t :tag "Subdirectory" |
| 462 |
|
:format "%{%t%}: %v" |
| 463 |
|
(const :tag "" :value :subdirectory) |
| 464 |
|
(directory :tag "Value")) |
| 465 |
|
(list :inline t :tag "Files" |
| 466 |
|
:format "%{%t%}: %v" |
| 467 |
|
(const :tag "" :value :files) |
| 468 |
|
(repeat :format "\n%v%i\n" |
| 469 |
|
(file :tag "File"))) |
| 470 |
|
,@patcher-project-options-custom-type)) |
| 471 |
|
)) |
| 472 |
|
) |
| 473 |
|
|
| 474 |
|
|
| 475 |
;; Project descriptors Accessors: |
;; Project descriptors Accessors: |
| 476 |
(defsubst patcher-project-name (project) (nth 0 project)) |
(defsubst patcher-project-name (project) (nth 0 project)) |
| 477 |
(defsubst patcher-project-directory (project) (nth 1 project)) |
|
| 478 |
|
(defun patcher-project-directory (project) |
| 479 |
|
;; Returns the project directory of PROJECT, possibly expanded as a project |
| 480 |
|
;; subdir if PROJECT is a subproject. |
| 481 |
|
(if (member project patcher-subprojects) |
| 482 |
|
(let ((prj (assoc (nth 1 project) patcher-projects))) |
| 483 |
|
(unless prj |
| 484 |
|
(error "Can't find base project for subproject `%s'" |
| 485 |
|
(patcher-project-name project))) |
| 486 |
|
(let ((subdir (patcher-project-option project :subdirectory))) |
| 487 |
|
(if subdir |
| 488 |
|
(expand-file-name subdir (patcher-project-directory prj)) |
| 489 |
|
(patcher-project-directory prj)))) |
| 490 |
|
;; else: (member project patcher-projects) |
| 491 |
|
(nth 1 project))) |
| 492 |
|
|
| 493 |
(defun patcher-project-option-1 (project option) |
(defun patcher-project-option-1 (project option) |
| 494 |
;; Try to find an option in the project descriptor, otherwise, try in each |
;; Try to find an option in the project descriptor, otherwise, try in each |
| 495 |
;; project from the project's inheritance list. |
;; project from the project's inheritance list. |
| 496 |
(let ((options (cddr project))) |
;; The whole option form is returned: '(:stuff value) |
| 497 |
(or (member option options) |
(let* ((is-subproject (member project patcher-subprojects)) |
| 498 |
|
(options (cddr project)) |
| 499 |
|
(value (member option options))) |
| 500 |
|
(unless value |
| 501 |
(let ((projs (cadr (member :inheritance options))) |
(let ((projs (cadr (member :inheritance options))) |
| 502 |
proj value) |
proj) |
| 503 |
|
;; If PROJECT is a subproject, we use only the base project as an |
| 504 |
|
;; inheritance list. |
| 505 |
|
(when is-subproject |
| 506 |
|
(if projs |
| 507 |
|
(warn "Option :inheritance in subproject `%s' will be unused" |
| 508 |
|
(patcher-project-name project))) |
| 509 |
|
(setq projs (list (nth 1 project)))) |
| 510 |
(when projs |
(when projs |
| 511 |
(while (and (not value) (setq proj (pop projs))) |
(while (and (not value) (setq proj (pop projs))) |
| 512 |
(setq value (patcher-project-option-1 |
(setq value (patcher-project-option-1 (assoc proj patcher-projects) |
|
(assoc proj patcher-projects) |
|
| 513 |
option)))) |
option)))) |
|
value)) |
|
| 514 |
)) |
)) |
| 515 |
|
;; Now some checkings. |
| 516 |
|
(when (and (eq option :files) value) |
| 517 |
|
(if is-subproject |
| 518 |
|
;; Return the files as a string, not as the original list. |
| 519 |
|
(setq value (list :files (mapconcat #'identity (cadr value) " "))) |
| 520 |
|
;; Projects shouldn't have a :file option. |
| 521 |
|
(warn "Option :file in project `%s' will be unused" |
| 522 |
|
(patcher-project-name project)) |
| 523 |
|
(setq value nil))) |
| 524 |
|
value)) |
| 525 |
|
|
| 526 |
(defun patcher-project-option (project option) |
(defun patcher-project-option (project option) |
| 527 |
;; Returns either a project's option, or the patcher-default-* value. |
;; Returns either a project's option, or the patcher-default-* value. |
| 537 |
;; Version management ======================================================= |
;; Version management ======================================================= |
| 538 |
|
|
| 539 |
;; $Format: "(defconst patcher-prcs-major-version \"$ProjectMajorVersion$\")"$ |
;; $Format: "(defconst patcher-prcs-major-version \"$ProjectMajorVersion$\")"$ |
| 540 |
(defconst patcher-prcs-major-version "version-2-2") |
(defconst patcher-prcs-major-version "version-2-4") |
| 541 |
;; $Format: "(defconst patcher-prcs-minor-version \"$ProjectMinorVersion$\")"$ |
;; $Format: "(defconst patcher-prcs-minor-version \"$ProjectMinorVersion$\")"$ |
| 542 |
(defconst patcher-prcs-minor-version "1") |
(defconst patcher-prcs-minor-version "1") |
| 543 |
(defconst patcher-version |
(defconst patcher-version |
| 580 |
)) |
)) |
| 581 |
|
|
| 582 |
(make-variable-buffer-local |
(make-variable-buffer-local |
| 583 |
|
(defvar patcher-diff-command nil |
| 584 |
|
;; Complete diff command to use for making the current patch. |
| 585 |
|
)) |
| 586 |
|
|
| 587 |
|
(make-variable-buffer-local |
| 588 |
(defvar patcher-change-logs nil |
(defvar patcher-change-logs nil |
| 589 |
;; List of ChangeLog file buffers concerned by the current patch. |
;; List of ChangeLog file buffers concerned by the current patch. |
| 590 |
)) |
)) |
| 591 |
|
|
| 592 |
(make-variable-buffer-local |
(make-variable-buffer-local |
| 593 |
|
(defvar patcher-change-logs-marker nil |
| 594 |
|
;; Marker indicating the beginning of the ChangeLog entries in the mail |
| 595 |
|
;; buffer. |
| 596 |
|
)) |
| 597 |
|
|
| 598 |
|
(make-variable-buffer-local |
| 599 |
(defvar patcher-patch-marker nil |
(defvar patcher-patch-marker nil |
| 600 |
;; Marker indicating the beginning of the patch in the mail buffer. |
;; Marker indicating the beginning of the patch in the mail buffer. |
| 601 |
)) |
)) |
| 606 |
)) |
)) |
| 607 |
|
|
| 608 |
(make-variable-buffer-local |
(make-variable-buffer-local |
| 609 |
|
(defvar patcher-commit-logmsg-buffer nil |
| 610 |
|
;; Buffer containing the log message of the commit command. |
| 611 |
|
)) |
| 612 |
|
|
| 613 |
|
(make-variable-buffer-local |
| 614 |
(defvar patcher-pre-commit-window-config nil |
(defvar patcher-pre-commit-window-config nil |
| 615 |
;; Window configuration when we're in the mail buffer, just prior to |
;; Window configuration when we're in the mail buffer, just prior to |
| 616 |
;; beginning a commit operation, so we can get back to it at the |
;; beginning a commit operation, so we can get back to it at the |
| 633 |
|
|
| 634 |
(defun patcher-offer-save-buffers (buffers) |
(defun patcher-offer-save-buffers (buffers) |
| 635 |
;; Offer to save some buffers. |
;; Offer to save some buffers. |
| 636 |
|
;; #### this should be a standard function somewhere. |
| 637 |
(map-y-or-n-p |
(map-y-or-n-p |
| 638 |
(lambda (buffer) |
(lambda (buffer) |
| 639 |
(and (buffer-modified-p buffer) |
(and (buffer-modified-p buffer) |
| 672 |
(insert (extent-string extent)) |
(insert (extent-string extent)) |
| 673 |
;; Be sure to map all extents. |
;; Be sure to map all extents. |
| 674 |
nil)) |
nil)) |
| 675 |
change-log nil nil nil nil 'patcher)) |
change-log nil nil nil nil 'patcher mail-buffer)) |
| 676 |
)) |
)) |
| 677 |
|
|
| 678 |
(defun patcher-construct-command (command files) |
(defun patcher-construct-command (command files) |
| 679 |
;; replace the %f with the specified files (if any), or append. |
;; Replace the %f with the specified files (if any), or append. |
| 680 |
(or files (setq files "")) |
(or files (setq files "")) |
| 681 |
(setq files (replace-in-string files "\\\\" "/")) |
(setq files (replace-in-string files "\\\\" "/")) |
| 682 |
(cond ((string-match "%f" command) |
(cond ((string-match "%f" command) |
| 683 |
(replace-in-string command "%f" files)) |
(replace-in-string (replace-in-string command "%f" files) |
| 684 |
|
"[ \t]+$" "")) |
| 685 |
((> (length files) 0) |
((> (length files) 0) |
| 686 |
(concat command " " files)) |
(concat command " " files)) |
| 687 |
(t command))) |
(t command))) |
| 688 |
|
|
| 689 |
(defun patcher-after-send (unused) |
(defun patcher-after-send (&optional unused) |
| 690 |
;; Do some cleanup after sending the mail. |
;; Do some cleanup after sending the mail. |
| 691 |
(when (patcher-project-option patcher-project |
(when (patcher-project-option patcher-project |
| 692 |
:kill-change-logs-after-sending) |
:kill-change-logs-after-sending) |
| 695 |
;; #### Implement kill-source-files-after-sending here. |
;; #### Implement kill-source-files-after-sending here. |
| 696 |
(when patcher-pre-commit-window-config |
(when patcher-pre-commit-window-config |
| 697 |
(set-window-configuration patcher-pre-commit-window-config)) |
(set-window-configuration patcher-pre-commit-window-config)) |
| 698 |
|
(when patcher-commit-logmsg-buffer |
| 699 |
|
(kill-buffer patcher-commit-logmsg-buffer)) |
| 700 |
(when patcher-commit-output-buffer |
(when patcher-commit-output-buffer |
| 701 |
(bury-buffer patcher-commit-output-buffer))) |
(bury-buffer patcher-commit-output-buffer))) |
| 702 |
|
|
| 722 |
(let* ((project (symbol-value-in-buffer 'patcher-project |
(let* ((project (symbol-value-in-buffer 'patcher-project |
| 723 |
patcher-logmsg-mail-buffer)) |
patcher-logmsg-mail-buffer)) |
| 724 |
(command (patcher-project-option project :commit-command)) |
(command (patcher-project-option project :commit-command)) |
| 725 |
|
(failed-command-regexp (patcher-project-option |
| 726 |
|
project :failed-command-regexp)) |
| 727 |
(confirm-commits (patcher-project-option project :confirm-commits)) |
(confirm-commits (patcher-project-option project :confirm-commits)) |
| 728 |
(change-logs (symbol-value-in-buffer 'patcher-change-logs |
(change-logs (symbol-value-in-buffer 'patcher-change-logs |
| 729 |
patcher-logmsg-mail-buffer)) |
patcher-logmsg-mail-buffer)) |
| 734 |
(symbol-value-in-buffer 'patcher-logmsg-file-name |
(symbol-value-in-buffer 'patcher-logmsg-file-name |
| 735 |
patcher-logmsg-mail-buffer)) |
patcher-logmsg-mail-buffer)) |
| 736 |
(output-buffer (get-buffer-create "*Patcher-Commit-Output*"))) |
(output-buffer (get-buffer-create "*Patcher-Commit-Output*"))) |
| 737 |
|
;; First, make sure the ChangeLogs are saved. |
| 738 |
(patcher-offer-save-buffers change-logs) |
(patcher-offer-save-buffers change-logs) |
| 739 |
|
;; Now, construct the commit command by starting with what was specified |
| 740 |
|
;; in this project's options (or read from the user, if the prefix arg was |
| 741 |
|
;; given) and (if subproject files were given) combining the specified |
| 742 |
|
;; files with the relevant ChangeLogs. If the whole project is being |
| 743 |
|
;; committed, the ChangeLogs will automatically be committed, otherwise we |
| 744 |
|
;; have to specify them explicitly. |
| 745 |
(let* ((directory (patcher-project-directory project)) |
(let* ((directory (patcher-project-directory project)) |
| 746 |
(files |
(files |
| 747 |
(let ((f (symbol-value-in-buffer |
(let ((f (symbol-value-in-buffer |
| 763 |
(replace-in-string command "%s" |
(replace-in-string command "%s" |
| 764 |
logmsg-file-name t) |
logmsg-file-name t) |
| 765 |
files))) |
files))) |
| 766 |
|
;; Maybe display the commit command, and make sure the user agrees. |
| 767 |
(when (or (not confirm-commits) |
(when (or (not confirm-commits) |
| 768 |
(save-window-excursion |
(save-window-excursion |
| 769 |
(let ((runbuf (get-buffer-create "*Patcher-Commit-Command*"))) |
(let ((runbuf (get-buffer-create "*Patcher-Commit-Command*"))) |
| 772 |
runbuf) |
runbuf) |
| 773 |
(display-buffer runbuf) |
(display-buffer runbuf) |
| 774 |
(y-or-n-p "Run commit command? ")))) |
(y-or-n-p "Run commit command? ")))) |
| 775 |
|
;; Write out the log message and ... |
| 776 |
(write-region (point-min) (point-max) logmsg-file-name nil 'silent) |
(write-region (point-min) (point-max) logmsg-file-name nil 'silent) |
| 777 |
(erase-buffer output-buffer) |
(erase-buffer output-buffer) |
| 778 |
|
;; ... commit! |
| 779 |
(shell-command command output-buffer) |
(shell-command command output-buffer) |
| 780 |
|
;; Record the buffers that we will get rid of later. Specifically, we |
| 781 |
|
;; will bury the output buffer and kill the log message buffer when we |
| 782 |
|
;; send the patch mail -- i.e. when we are done with this project. We |
| 783 |
|
;; don't kill the log message buffer now in case the user needs it later |
| 784 |
|
;; -- e.g. if the commit failed and needs to be redone (we try to |
| 785 |
|
;; detect this, but we might not succeed in all cases.). The reason we |
| 786 |
|
;; kill, not bury, the log message buffer is that it is generated anew |
| 787 |
|
;; for each commit action, and we don't want to accumulate these buffers |
| 788 |
|
;; endlessly. the output buffer is reused each time we execute the |
| 789 |
|
;; commit, so no such problem exists here. |
| 790 |
|
(let ((curbuf (current-buffer))) |
| 791 |
(with-current-buffer patcher-logmsg-mail-buffer |
(with-current-buffer patcher-logmsg-mail-buffer |
| 792 |
;; Note that this sets a buffer-local variable in the mail buffer, |
;; Note that this sets a buffer-local variable in the mail buffer, |
| 793 |
;; not our own buffer. |
;; not our own buffer. |
| 794 |
|
(setq patcher-commit-logmsg-buffer curbuf) |
| 795 |
(if (buffer-live-p output-buffer) |
(if (buffer-live-p output-buffer) |
| 796 |
(setq patcher-commit-output-buffer output-buffer)) |
(setq patcher-commit-output-buffer output-buffer)))) |
| 797 |
|
;; Try to see if the commit failed. |
| 798 |
|
(if (and (buffer-live-p output-buffer) |
| 799 |
|
(with-current-buffer output-buffer |
| 800 |
|
(save-excursion |
| 801 |
|
(goto-char (point-min)) |
| 802 |
|
(re-search-forward failed-command-regexp nil t)))) |
| 803 |
|
;; It failed. |
| 804 |
|
(progn |
| 805 |
|
(display-buffer output-buffer) |
| 806 |
|
(message "Error during commit. Please correct and try again.")) |
| 807 |
|
;; Otherwise, record the successful commit in the mail message. |
| 808 |
|
(with-current-buffer patcher-logmsg-mail-buffer |
| 809 |
(save-excursion |
(save-excursion |
| 810 |
(goto-char (point-min)) |
(goto-char (point-min)) |
| 811 |
(when (search-forward mail-header-separator nil t) |
(when (search-forward mail-header-separator nil t) |
| 813 |
(insert (concat (patcher-project-option patcher-project |
(insert (concat (patcher-project-option patcher-project |
| 814 |
:committed-notice) |
:committed-notice) |
| 815 |
"\n"))))) |
"\n"))))) |
| 816 |
(kill-buffer (current-buffer)) |
;; Bury the log message (see above). Remove the log message window |
| 817 |
|
;; and display the output buffer. |
| 818 |
|
(bury-buffer (current-buffer)) |
| 819 |
(set-window-configuration pre-commit-window-config) |
(set-window-configuration pre-commit-window-config) |
| 820 |
(if (buffer-live-p output-buffer) |
(if (buffer-live-p output-buffer) |
| 821 |
(display-buffer output-buffer))) |
(display-buffer output-buffer))) |
| 822 |
)) |
))) |
| 823 |
|
|
| 824 |
(defvar patcher-logmsg-mode-map |
(defvar patcher-logmsg-mode-map |
| 825 |
(let ((map (make-sparse-keymap))) |
(let ((map (make-sparse-keymap))) |
| 876 |
:group 'patcher |
:group 'patcher |
| 877 |
:type 'hook) |
:type 'hook) |
| 878 |
|
|
| 879 |
|
(defun patcher-generate-diff () |
| 880 |
|
"(Re)generate the diff in the current Patcher mail buffer. |
| 881 |
|
When appropriate, this function first removes any formerly generated diff. |
| 882 |
|
The diff output will be inserted at the current position, or at the place |
| 883 |
|
where a former diff output was found, if any. Normally, you don't have to |
| 884 |
|
call this function by hand, as `patcher-mail' and `patcher-mail-subproject' |
| 885 |
|
will do it for you. However, you may have to if the initial diff command |
| 886 |
|
failed for some reason." |
| 887 |
|
(interactive) |
| 888 |
|
(let ((diff-extent |
| 889 |
|
(car (extent-list nil nil nil nil 'patcher-diff))) |
| 890 |
|
(change-logs-extent |
| 891 |
|
(car (extent-list nil nil nil nil 'patcher-change-logs))) |
| 892 |
|
(regenerate t)) |
| 893 |
|
(save-excursion |
| 894 |
|
;; First, clean up the place. |
| 895 |
|
(when patcher-change-logs |
| 896 |
|
(save-window-excursion |
| 897 |
|
(save-excursion |
| 898 |
|
(with-output-to-temp-buffer " *Patcher Information" |
| 899 |
|
(set-buffer " *Patcher Information") |
| 900 |
|
(if change-logs-extent |
| 901 |
|
(insert "\ |
| 902 |
|
It appears that ChangeLog entries for this patch have already been generated, |
| 903 |
|
edited and inserted into the mail buffer.\n\n") |
| 904 |
|
(insert "\ |
| 905 |
|
It appears that ChangeLog skeletons for this patch have already been generated, |
| 906 |
|
and maybe edited.\n\n")) |
| 907 |
|
(insert "\ |
| 908 |
|
If you answer `yes' to the question below, both the diff and the ChangeLog |
| 909 |
|
entries will be regenerated. This means that current ChangeLog entries will be |
| 910 |
|
lost. If otherwise your answer is `no', only the diff will be regenerated.")) |
| 911 |
|
(setq regenerate (yes-or-no-p "\ |
| 912 |
|
Regenerate both patch and ChangeLog skeleton ? ")))) |
| 913 |
|
(when regenerate |
| 914 |
|
(when change-logs-extent |
| 915 |
|
(delete-region (extent-start-position change-logs-extent) |
| 916 |
|
(extent-end-position change-logs-extent)) |
| 917 |
|
(delete-extent change-logs-extent)) |
| 918 |
|
(dolist (change-log patcher-change-logs) |
| 919 |
|
(map-extents |
| 920 |
|
#'(lambda (extent unused) |
| 921 |
|
(delete-region (extent-start-position extent) |
| 922 |
|
(extent-end-position extent) |
| 923 |
|
(extent-object extent)) |
| 924 |
|
(delete-extent extent) |
| 925 |
|
;; Be sure to map all extents. |
| 926 |
|
nil) |
| 927 |
|
change-log nil nil nil nil 'patcher (current-buffer))))) |
| 928 |
|
(when diff-extent |
| 929 |
|
(delete-region (extent-start-position diff-extent) |
| 930 |
|
(extent-end-position diff-extent)) |
| 931 |
|
(delete-extent diff-extent)) |
| 932 |
|
(goto-char patcher-patch-marker) |
| 933 |
|
(message "Generating the diff...") |
| 934 |
|
(sit-for 0) ;; Let XEmacs redisplay the message buffer |
| 935 |
|
(apply 'call-process shell-file-name nil t nil |
| 936 |
|
shell-command-switch `(,patcher-diff-command)) |
| 937 |
|
(message "Generating the diff... done") |
| 938 |
|
(sit-for 0) ;; Let XEmacs redisplay the message buffer |
| 939 |
|
;; Remember the command output region. |
| 940 |
|
(setq diff-extent (make-extent patcher-patch-marker (point))) |
| 941 |
|
(set-extent-properties diff-extent '(start-open t patcher-diff t)) |
| 942 |
|
;; Try to see if the diff failed. |
| 943 |
|
(if (save-excursion |
| 944 |
|
(goto-char (extent-start-position diff-extent)) |
| 945 |
|
(re-search-forward |
| 946 |
|
(patcher-project-option patcher-project |
| 947 |
|
:failed-command-regexp) |
| 948 |
|
nil t)) |
| 949 |
|
;; It failed. |
| 950 |
|
(message (substitute-command-keys "Error during diff. \ |
| 951 |
|
Please fix the problem and type \\[patcher-generate-diff] to try again.")) |
| 952 |
|
;; It succeeded. |
| 953 |
|
(when regenerate |
| 954 |
|
(message "Generating the ChangeLog skeletons...") |
| 955 |
|
(sit-for 0) ;; Let XEmacs redisplay the message buffer |
| 956 |
|
(narrow-to-region (extent-start-position diff-extent) |
| 957 |
|
(extent-end-position diff-extent)) |
| 958 |
|
(setq patcher-change-logs |
| 959 |
|
(patch-to-change-log (patcher-project-directory |
| 960 |
|
patcher-project) |
| 961 |
|
:keep-source-files |
| 962 |
|
(not (patcher-project-option |
| 963 |
|
patcher-project |
| 964 |
|
:kill-source-files-after-diffing)) |
| 965 |
|
:extent-property 'patcher |
| 966 |
|
:extent-property-value (current-buffer))) |
| 967 |
|
(widen) |
| 968 |
|
(message (substitute-command-keys |
| 969 |
|
"Please annotate the ChangeLogs, \ |
| 970 |
|
and run \\[patcher-insert-change-logs] from this buffer when done.")))) |
| 971 |
|
))) |
| 972 |
|
|
| 973 |
(defun patcher-insert-change-logs () |
(defun patcher-insert-change-logs () |
| 974 |
"Insert annotated ChangeLog entries, after `patcher-mail' has been run. |
"Insert annotated ChangeLog entries, after `patcher-mail' has been run. |
| 975 |
Run this command after you've run `patcher-mail' and then annotated the |
Run this command after you've run `patcher-mail' and then annotated the |
| 976 |
ChangeLog skeletons that were created." |
ChangeLog skeletons that were created." |
| 977 |
(interactive) |
(interactive) |
| 978 |
(save-excursion |
(save-excursion |
| 979 |
(goto-char patcher-patch-marker) |
(let ((extent (car (extent-list nil nil nil nil 'patcher-change-logs)))) |
| 980 |
(patcher-insert-change-logs-1 (current-buffer)))) |
(when (and extent |
| 981 |
|
(y-or-n-p "ChangeLog entries already inserted. Replace ? ")) |
| 982 |
|
(delete-region (extent-start-position extent) |
| 983 |
|
(extent-end-position extent)) |
| 984 |
|
(delete-extent extent)) |
| 985 |
|
(goto-char patcher-change-logs-marker) |
| 986 |
|
(patcher-insert-change-logs-1 (current-buffer)) |
| 987 |
|
(setq extent (make-extent patcher-change-logs-marker (point))) |
| 988 |
|
(set-extent-properties extent '(start-open t patcher-change-logs t))) |
| 989 |
|
)) |
| 990 |
|
|
| 991 |
|
(defun patcher-compress-commit-log () |
| 992 |
|
;; After the ChangeLogs have been inserted into the commit log message |
| 993 |
|
;; buffer, this function compresses the output into something that |
| 994 |
|
;; conveys the essence of what has been changed, but much more compactly. |
| 995 |
|
|
| 996 |
|
;;(interactive) for testing |
| 997 |
|
(goto-char (point-min)) |
| 998 |
|
(delete-matching-lines "^\\(\\S-+\\)?ChangeLog addition:$") |
| 999 |
|
(delete-matching-lines "^[0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9] ") |
| 1000 |
|
;; Now compress the change log specs into just files, so that mostly just |
| 1001 |
|
;; the annotations are left. |
| 1002 |
|
(let ((change-log-change-line |
| 1003 |
|
"^\\([ \t]+\\)\\* \\(\\S-+\\)\\( (.*)\\)?:\\( New\\.\\)?")) |
| 1004 |
|
(while (re-search-forward change-log-change-line nil t) |
| 1005 |
|
(let ((beg (match-beginning 1)) ;; Change to match-end if you want the |
| 1006 |
|
;; indentation. |
| 1007 |
|
(end (match-end 0)) |
| 1008 |
|
files) |
| 1009 |
|
(push (match-string 2) files) |
| 1010 |
|
(forward-line 1) |
| 1011 |
|
(while (looking-at change-log-change-line) |
| 1012 |
|
(setq end (match-end 0)) |
| 1013 |
|
(unless (member (match-string 2) files) |
| 1014 |
|
(push (match-string 2) files)) |
| 1015 |
|
(forward-line 1)) |
| 1016 |
|
(goto-char beg) |
| 1017 |
|
(delete-region beg end) |
| 1018 |
|
(insert (mapconcat 'identity (nreverse files) ", ") ":") |
| 1019 |
|
(when (looking-at "\\s-+") |
| 1020 |
|
(let ((p (point)) |
| 1021 |
|
(end (match-end 0))) |
| 1022 |
|
;; If there's no annotation at all for this change, make sure we |
| 1023 |
|
;; don't treat the next change as an annotation for this one! |
| 1024 |
|
(if (save-excursion |
| 1025 |
|
(goto-char end) |
| 1026 |
|
(beginning-of-line) |
| 1027 |
|
(looking-at change-log-change-line)) |
| 1028 |
|
(progn |
| 1029 |
|
(if (looking-at "[ \t]+") |
| 1030 |
|
(delete-region p (match-end 0)))) |
| 1031 |
|
(delete-region p end) |
| 1032 |
|
(insert " ")))) |
| 1033 |
|
))) |
| 1034 |
|
;; Shrink extra blank lines. |
| 1035 |
|
(let ((blank-line "^\\s-*$")) |
| 1036 |
|
(goto-char (point-min)) |
| 1037 |
|
(while (and (not (eobp)) |
| 1038 |
|
(progn (forward-line 1) (re-search-forward blank-line nil t))) |
| 1039 |
|
(delete-blank-lines)) |
| 1040 |
|
(goto-char (point-min)) |
| 1041 |
|
(if (looking-at blank-line) |
| 1042 |
|
(delete-blank-lines)))) |
| 1043 |
|
|
| 1044 |
(defun patcher-commit-change (arg) |
(defun patcher-commit-change (arg) |
| 1045 |
"Prepare to (and possibly) commit a change to a project's repository. |
"Prepare to (and possibly) commit a change to a project's repository. |
| 1069 |
(save-excursion |
(save-excursion |
| 1070 |
(goto-char (point-min)) |
(goto-char (point-min)) |
| 1071 |
(and (re-search-forward |
(and (re-search-forward |
| 1072 |
"^Subject: \\(\\[PATCH\\]\\s-*\\)?\\(.*\\)$" |
"\ |
| 1073 |
|
^Subject:[ \t\f\r]+\\(\\[PATCH\\][ \t\f\r]*\\)?\\(.*\\)$" |
| 1074 |
nil t) |
nil t) |
| 1075 |
(concat (match-string 2) "\n")))))) |
(concat (match-string 2) "\n")))))) |
| 1076 |
((eq init-log-message 'change-logs) |
((eq init-log-message 'change-logs) |
| 1077 |
(patcher-insert-change-logs-1 mail-buffer)) |
(patcher-insert-change-logs-1 mail-buffer)) |
| 1078 |
|
((eq init-log-message 'compressed-change-logs) |
| 1079 |
|
(patcher-insert-change-logs-1 mail-buffer) |
| 1080 |
|
(patcher-compress-commit-log)) |
| 1081 |
|
((eq init-log-message 'compressed-change-logs-with-original) |
| 1082 |
|
(patcher-insert-change-logs-1 mail-buffer) |
| 1083 |
|
(let ((orig (buffer-string))) |
| 1084 |
|
(patcher-compress-commit-log) |
| 1085 |
|
(goto-char (point-max)) |
| 1086 |
|
(insert "\ |
| 1087 |
|
\n\n---------------- Original ChangeLog entries follow: ----------------\n\n") |
| 1088 |
|
(insert orig))) |
| 1089 |
(t |
(t |
| 1090 |
(insert "(none)"))) |
(insert "(none)"))) |
| 1091 |
|
(goto-char (point-min)) |
| 1092 |
(if edit-log-message |
(if edit-log-message |
| 1093 |
(message (substitute-command-keys |
(message (substitute-command-keys |
| 1094 |
"Edit the log message, \ |
"Edit the log message, \ |
| 1098 |
|
|
| 1099 |
(defvar patcher-minor-mode-map |
(defvar patcher-minor-mode-map |
| 1100 |
(let ((map (make-sparse-keymap 'patcher-minor-mode-map))) |
(let ((map (make-sparse-keymap 'patcher-minor-mode-map))) |
| 1101 |
|
(define-key map [(control c) (control p) d] 'patcher-generate-diff) |
| 1102 |
(define-key map [(control c) (control p) i] 'patcher-insert-change-logs) |
(define-key map [(control c) (control p) i] 'patcher-insert-change-logs) |
| 1103 |
(define-key map [(control c) (control p) c] 'patcher-commit-change) |
(define-key map [(control c) (control p) c] 'patcher-commit-change) |
| 1104 |
(define-key map [(control c) (control p) v] 'patcher-version) |
(define-key map [(control c) (control p) v] 'patcher-version) |
| 1133 |
address for sending the message. Otherwise, the address is prompted for." |
address for sending the message. Otherwise, the address is prompted for." |
| 1134 |
(compose-mail (or (patcher-project-option project :to-address) |
(compose-mail (or (patcher-project-option project :to-address) |
| 1135 |
(read-string "To address: ")) |
(read-string "To address: ")) |
| 1136 |
subject nil nil nil nil '(patcher-after-send))) |
subject nil nil nil nil '((patcher-after-send)))) |
| 1137 |
|
|
| 1138 |
(defun patcher-mail-sendmail (project subject) |
(defun patcher-mail-sendmail (project subject) |
| 1139 |
"Prepare a patch-related mail with the `mail' function. |
"Prepare a patch-related mail with the `mail' function. |
| 1144 |
(require 'sendmail) |
(require 'sendmail) |
| 1145 |
(mail nil (or (patcher-project-option project :to-address) |
(mail nil (or (patcher-project-option project :to-address) |
| 1146 |
(read-string "To address: ")) |
(read-string "To address: ")) |
| 1147 |
subject nil nil nil '(patcher-after-send))) |
subject nil nil nil '((patcher-after-send)))) |
|
|
|
| 1148 |
|
|
| 1149 |
|
(defvar message-exit-actions) |
| 1150 |
(defun patcher-mail-message (project subject) |
(defun patcher-mail-message (project subject) |
| 1151 |
"Prepare a patch-related mail with the `message-mail' function. |
"Prepare a patch-related mail with the `message-mail' function. |
| 1152 |
This method requires the `message' library. |
This method requires the `message' library. |
| 1156 |
(require 'message) |
(require 'message) |
| 1157 |
(message-mail (or (patcher-project-option project :to-address) |
(message-mail (or (patcher-project-option project :to-address) |
| 1158 |
(read-string "To address: ")) |
(read-string "To address: ")) |
| 1159 |
subject nil nil nil nil '(patcher-after-send))) |
subject nil nil nil nil '(patcher-after-send)) |
| 1160 |
|
;; #### There appears to be a bug in message.el: message-mail completely |
| 1161 |
|
;; ignores the `send-actions' argument! So we need to set the value |
| 1162 |
|
;; ourselves. `message-exit-actions' seems more appropriate than |
| 1163 |
|
;; `message-send-actions'. |
| 1164 |
|
(push '(patcher-after-send) message-exit-actions)) |
| 1165 |
|
|
| 1166 |
(defun patcher-mail-gnus (project subject) |
(defun patcher-mail-gnus (project subject) |
| 1167 |
"Prepare a patch-related mail with the `gnus-post-news' function. |
"Prepare a patch-related mail with the `gnus-post-news' function. |
| 1174 |
(require 'gnus-util) |
(require 'gnus-util) |
| 1175 |
(unless (gnus-alive-p) |
(unless (gnus-alive-p) |
| 1176 |
(error "You should have Gnus running in this XEmacs session")) |
(error "You should have Gnus running in this XEmacs session")) |
| 1177 |
;; this binding is necessary to let message-mode hooks perform correctly |
;; This binding is necessary to let message-mode hooks perform correctly. |
| 1178 |
(let ((gnus-newsgroup-name (or (patcher-project-option project :gnus-group) |
(let ((gnus-newsgroup-name (or (patcher-project-option project :gnus-group) |
| 1179 |
(read-string "Gnus group name: ")))) |
(read-string "Gnus group name: ")))) |
| 1180 |
(gnus-post-news 'post gnus-newsgroup-name) |
(gnus-post-news 'post gnus-newsgroup-name) |
| 1204 |
(patcher-project-option project :mail-method)))) |
(patcher-project-option project :mail-method)))) |
| 1205 |
project (concat "[PATCH] " subject)) |
project (concat "[PATCH] " subject)) |
| 1206 |
(patcher-minor-mode t) |
(patcher-minor-mode t) |
|
(setq patcher-project project) |
|
|
(setq patcher-files files) |
|
| 1207 |
(cd directory) |
(cd directory) |
| 1208 |
(and (patcher-project-option project :mail-prologue) |
(let ((mail-prologue (patcher-project-option project :mail-prologue))) |
| 1209 |
(insert "\n" (patcher-project-option project :mail-prologue))) |
(and mail-prologue (insert "\n" mail-prologue))) |
| 1210 |
(save-excursion |
(save-excursion |
| 1211 |
(insert "\n\n") |
(insert "\n\n") |
| 1212 |
(setq patcher-patch-marker (point-marker)) |
(setq patcher-change-logs-marker (point-marker)) |
| 1213 |
(when override |
(insert "\n") |
| 1214 |
|
(and override |
| 1215 |
(setq command (read-shell-command "Diff command: " command))) |
(setq command (read-shell-command "Diff command: " command))) |
| 1216 |
(setq command (patcher-construct-command command files)) |
(setq command (patcher-construct-command command files)) |
| 1217 |
(message "Generating the diff ...") |
(let ((diff-prologue (patcher-project-option project :diff-prologue))) |
| 1218 |
(insert (format "%s Patch (%s):\n\n" |
(and diff-prologue |
| 1219 |
(patcher-project-name project) command)) |
(insert (replace-in-string |
| 1220 |
(sit-for 0) ;; Let XEmacs redisplay the message buffer |
(replace-in-string diff-prologue |
| 1221 |
(shell-command command 'here) |
"%n" (patcher-project-name project)) |
| 1222 |
(message "Generating the ChangeLog skeletons ...") |
"%c" command) |
| 1223 |
(sit-for 0) ;; Let XEmacs redisplay the message buffer |
"\n\n"))) |
| 1224 |
(narrow-to-region (point) (mark t)) |
(setq patcher-project project |
| 1225 |
(setq patcher-change-logs |
patcher-files files |
| 1226 |
(patch-to-change-log directory |
patcher-diff-command command |
| 1227 |
:keep-source-files |
patcher-patch-marker (point-marker)) |
| 1228 |
(not (patcher-project-option |
(patcher-generate-diff)) |
| 1229 |
project |
)) |
|
:kill-source-files-after-diffing)) |
|
|
:extent-property 'patcher |
|
|
:extent-property-value (current-buffer))) |
|
|
(widen) |
|
|
(message (substitute-command-keys |
|
|
"Please annotate the ChangeLogs, \ |
|
|
and run \\[patcher-insert-change-logs] from this buffer when done.")) |
|
|
))) |
|
| 1230 |
|
|
| 1231 |
(defvar patcher-projects-history nil |
(defvar patcher-projects-history nil |
| 1232 |
;; History used for prompting patcher projects. |
;; History used for prompting patcher projects. |
| 1235 |
;;;###autoload |
;;;###autoload |
| 1236 |
(defun patcher-mail-subproject (project subject files &optional arg) |
(defun patcher-mail-subproject (project subject files &optional arg) |
| 1237 |
"Prepare a mail about a patch to apply on part of a project. |
"Prepare a mail about a patch to apply on part of a project. |
| 1238 |
PROJECT is the name of the project (see the variable `patcher-projects'). |
PROJECT is the name of the project (see the variables `patcher-projects' |
| 1239 |
|
and `patcher-subprojects'). |
| 1240 |
SUBJECT is the subject of the mail. |
SUBJECT is the subject of the mail. |
| 1241 |
FILES is a string listing one or more files, possibly with wild cards -- |
FILES is a string listing one or more files, possibly with wild cards -- |
| 1242 |
essentially, part of a command line to be interpolated into the `diff' |
essentially, part of a command line to be interpolated into the `diff' |
| 1243 |
and maybe the `commit' commands issued by Patcher. |
and maybe the `commit' commands issued by Patcher. |
| 1244 |
|
|
| 1245 |
When called interactively, use a prefix (ARG) to override the value of |
When called interactively, use a prefix (ARG) to override the value of |
| 1246 |
the diff command to use for this project. If you want to work on a |
the diff command to use for this project. |
| 1247 |
subset of the project (e.g. some files, subdirectories etc), use the |
|
| 1248 |
function `patcher-mail-subproject' preferably. |
This function is intended for one-time only subprojects. Alternately, you |
| 1249 |
|
can define subprojects in the variable `patcher-subprojects' and continue |
| 1250 |
|
using `patcher-mail'. If you call this function on a predefine subproject, |
| 1251 |
|
you will have the opportunity to modify the predefined list of files or |
| 1252 |
|
directories the subproject is composed of. |
| 1253 |
|
|
| 1254 |
When you use this command instead of `patcher-mail', any commits issued |
When you use this command instead of `patcher-mail', any commits issued |
| 1255 |
from the mail buffer (using \\<patcher-minor-mode-map>\\[patcher-commit-change]) will automatically include the associated ChangeLogs, |
from the mail buffer (using \\<patcher-minor-mode-map>\\[patcher-commit-change]) will automatically include the associated ChangeLogs, |
| 1260 |
you use `patcher-mail-subproject' and the sections of the project don't |
you use `patcher-mail-subproject' and the sections of the project don't |
| 1261 |
overlap." |
overlap." |
| 1262 |
(interactive |
(interactive |
| 1263 |
(let* ((prj (assoc (completing-read "Project: " patcher-projects |
(let* ((prj (assoc (completing-read "Project: " (append patcher-subprojects |
| 1264 |
|
patcher-projects) |
| 1265 |
nil t nil 'patcher-projects-history) |
nil t nil 'patcher-projects-history) |
| 1266 |
patcher-projects)) |
(append patcher-subprojects patcher-projects))) |
| 1267 |
(sbj (read-string "Subject: ")) |
(sbj (read-string |
| 1268 |
|
"Subject: " |
| 1269 |
|
(let ((s (patcher-project-option prj :subject))) |
| 1270 |
|
(and s |
| 1271 |
|
(replace-in-string s "%n" (patcher-project-name prj))) |
| 1272 |
|
))) |
| 1273 |
(dir (patcher-project-directory prj)) |
(dir (patcher-project-directory prj)) |
| 1274 |
(fils (let ((default-directory (file-name-as-directory dir))) |
(fls (let ((default-directory (file-name-as-directory dir))) |
| 1275 |
;; Supply the current buffer's file as the default, since |
(or (let ((f (patcher-project-option prj :files))) |
| 1276 |
;; often we just finished working on a file and want to |
(and f (read-shell-command "Files: " |
| 1277 |
;; submit it as a patch. |
(concat f " ") nil f))) |
| 1278 |
|
;; - Ben sez: Supply the current buffer's file as the |
| 1279 |
|
;; default, since often we just finished working on a |
| 1280 |
|
;; file and want to submit it as a patch. |
| 1281 |
|
;; - Didier answers: ... without even testing what you've |
| 1282 |
|
;; done ? You're a BBDB (Bad Boy, Dear Ben ;-) !! |
| 1283 |
(let* ((default-file (and (buffer-file-name) |
(let* ((default-file (and (buffer-file-name) |
| 1284 |
(patcher-file-relative-name |
(patcher-file-relative-name |
| 1285 |
(buffer-file-name) |
(buffer-file-name) |
| 1286 |
dir))) |
dir))) |
| 1287 |
(default-file |
(default-file |
| 1288 |
;; If the file is not actually underneath the |
;; If the file is not actually underneath the |
| 1289 |
;; project, then don't suggest it as a possibility. |
;; project, then don't suggest it as a |
| 1290 |
|
;; possibility. |
| 1291 |
(and default-file |
(and default-file |
| 1292 |
(if (string-match "^\\.\\.$\\|^\\.\\.[/\\]" |
(if (string-match "^\\.\\.$\\|^\\.\\.[/\\]" |
| 1293 |
default-file) |
default-file) |
| 1294 |
nil default-file)))) |
nil default-file)))) |
| 1295 |
(read-shell-command |
(read-shell-command |
| 1296 |
(if default-file |
(if default-file (format "Files (%s): " default-file) |
|
(format "Files (%s): " default-file) |
|
| 1297 |
"Files: ") |
"Files: ") |
| 1298 |
nil nil default-file))))) |
nil nil default-file)))))) |
| 1299 |
(list prj sbj fils current-prefix-arg))) |
(list prj sbj fls current-prefix-arg))) |
| 1300 |
(patcher-mail-1 project subject files (and arg (interactive-p)))) |
(patcher-mail-1 project subject files (and arg (interactive-p)))) |
| 1301 |
|
|
| 1302 |
;;;###autoload |
;;;###autoload |
| 1303 |
(defun patcher-mail (project subject &optional arg) |
(defun patcher-mail (project subject &optional arg) |
| 1304 |
"Prepare a mail about a patch to apply on a project. |
"Prepare a mail about a patch to apply on a project. |
| 1305 |
PROJECT is the name of the project (see the variable `patcher-projects'). |
PROJECT is the name of the project (see the variables `patcher-projects' |
| 1306 |
|
and `patcher-subprojects'). |
| 1307 |
SUBJECT is the subject of the mail. |
SUBJECT is the subject of the mail. |
| 1308 |
|
|
| 1309 |
When called interactively, use a prefix (ARG) to override the value of |
When called interactively, use a prefix (ARG) to override the value of |
| 1310 |
the diff command to use for this project. If you want to work on a |
the diff command to use for this project. If you want to work on a |
| 1311 |
subset of the project (e.g. some files, subdirectories etc), use the |
subset of the project (e.g. some files, subdirectories etc), you have two |
| 1312 |
function `patcher-mail-subproject' preferably. |
alternatives: |
| 1313 |
|
|
| 1314 |
|
- for temporary subprojects, you can use the function |
| 1315 |
|
`patcher-mail-subproject', which lets you specify the list of modified |
| 1316 |
|
files / directories. |
| 1317 |
|
- otherwise, you can also define the subprojects in the variable |
| 1318 |
|
`patcher-subprojects' and continue using this function. |
| 1319 |
|
|
| 1320 |
Please note that you can have multiple occurrences of a Patcher mail at |
Please note that you can have multiple occurrences of a Patcher mail at |
| 1321 |
the same time, but not more than one at a time on the same project unless |
the same time, but not more than one at a time on the same project unless |
| 1322 |
you use `patcher-mail-subproject' and the sections of the project don't |
you use `patcher-mail-subproject' and the sections of the project don't |
| 1323 |
overlap." |
overlap." |
| 1324 |
(interactive |
(interactive |
| 1325 |
(let* ((prj (assoc (completing-read "Project: " patcher-projects |
(let* ((prj (assoc (completing-read "Project: " (append patcher-subprojects |
| 1326 |
|
patcher-projects) |
| 1327 |
nil t nil 'patcher-projects-history) |
nil t nil 'patcher-projects-history) |
| 1328 |
patcher-projects)) |
(append patcher-subprojects patcher-projects))) |
| 1329 |
(sbj (read-string "Subject: "))) |
(sbj (read-string |
| 1330 |
|
"Subject: " |
| 1331 |
|
(let ((s (patcher-project-option prj :subject))) |
| 1332 |
|
(and s |
| 1333 |
|
(replace-in-string s "%n" (patcher-project-name prj))) |
| 1334 |
|
)))) |
| 1335 |
(list prj sbj current-prefix-arg))) |
(list prj sbj current-prefix-arg))) |
| 1336 |
(patcher-mail-1 project subject nil (and arg (interactive-p)))) |
(patcher-mail-1 project subject (patcher-project-option project :files) |
| 1337 |
|
(and arg (interactive-p)))) |
| 1338 |
|
|
| 1339 |
(provide 'patcher) |
(provide 'patcher) |
| 1340 |
|
|
Parent Directory
| 
Revision Log
| 
Patch
