cgit.sxemacs.org Git - packages/blob - xemacs-packages/patcher/lisp/patcher-project.el

   1 ;;; patcher-project.el --- Project implementation
   2
   3 ;; Copyright (C) 2008, 2009, 2010, 2011 Didier Verna
   4 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007 Didier Verna
   5
   6 ;; Author:        Didier Verna <didier@xemacs.org>
   7 ;; Maintainer:    Didier Verna <didier@xemacs.org>
   8 ;; Created:       Sat Feb 13 15:02:50 2010
   9 ;; Last Revision: Sun Dec 11 12:16:22 2011
  10 ;; Keywords:      maint
  11
  12
  13 ;; This file is part of Patcher.
  14
  15 ;; Patcher is free software; you can redistribute it and/or modify
  16 ;; it under the terms of the GNU General Public License version 3,
  17 ;; as published by the Free Software Foundation.
  18
  19 ;; Patcher is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with this program; if not, write to the Free Software
  26 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  27
  28
  29 ;;; Commentary:
  30
  31 ;; Contents management by FCM version 0.1.
  32
  33
  34 ;;; Code:
  35
  36 (require 'cl)
  37
  38 (eval-when-compile (require 'patcher-cutil))
  39 (require 'patcher-util)
  40
  41
  42 \f
  43 ;; ===========================================================================
  44 ;; Utilities
  45 ;; ===========================================================================
  46
  47 (defmacro patcher-string-or-nil-custom-type (tag)
  48   ;; Creates a string-or-nil custom type with TAG for the nil case.
  49   `'(choice (const :tag ,tag nil)
  50             string))
  51
  52 (defconst +patcher-string-or-none-custom-type+
  53   (patcher-string-or-nil-custom-type "None"))
  54
  55 (defconst +patcher-string-or-ask-custom-type+
  56   (patcher-string-or-nil-custom-type "Ask"))
  57
  58 (defconst +patcher-string-or-default-custom-type+
  59   (patcher-string-or-nil-custom-type "Default"))
  60
  61
  62 (patcher-define-error 'project-option
  63   "Patcher project option error")
  64
  65 (patcher-define-error 'invalid-project-option
  66   "Patcher invalid project option error"
  67   'project-option)
  68
  69
  70
  71 \f
  72 ;; ===========================================================================
  73 ;; Project options and fallback variables
  74 ;; ===========================================================================
  75
  76 (defgroup patcher nil
  77   "Automatic archive-base project maintenance.")
  78
  79 (defgroup patcher-default nil
  80   "Patcher settings for default project options."
  81   :group 'patcher)
  82
  83 (defvar +patcher-project-options-custom-type+ ())
  84
  85 (put 'patcher-define-project-option 'lisp-indent-function 2)
  86 (defmacro* patcher-define-project-option
  87     (name default-value docstring tag custom-type
  88      &optional (alternate-custom-type custom-type))
  89   ;; Create a project option fallback variable `patcher-default-NAME', and
  90   ;; push CUSTOM-TYPE at the end of `+patcher-project-options-custom-type+'.
  91   `(progn
  92      (patcher-endpush
  93       `(list :inline t :tag ,,tag
  94              :format "%{%t%}: %v"
  95              (const :tag "" :value ,,(intern (concat ":" (symbol-name name))))
  96              ,,alternate-custom-type)
  97       +patcher-project-options-custom-type+)
  98      (defcustom ,(intern (concat "patcher-default-" (symbol-name name)))
  99        ,default-value
 100        ,docstring
 101        :group 'patcher-default
 102        :type  ,custom-type)))
 103
 104
 105 (patcher-define-project-option name nil
 106   "*Default name for Patcher projects.
 107
 108 This project option (a string) exists to let you define different Patcher
 109 projects (hence with different names) sharing a common name for the
 110 underlying diff and commit commands.  If set, it will be used rather than
 111 the real project's name."
 112   "Project name"
 113   '(choice (const :tag "Patcher name" nil)
 114            (string :tag "Other name")))
 115
 116 (patcher-define-project-option mail-method 'compose-mail
 117   "*Default method used by Patcher to prepare a mail.
 118
 119 Currently, there are four built-in methods: 'compose-mail \(the default),
 120 'sendmail, 'message, 'gnus and 'fake.  Please refer to the corresponding
 121 `patcher-mail-*' function for a description of each method.
 122
 123 You can also define your own method, say `foo'.  In that case, you *must*
 124 provide a function named `patcher-mail-foo' which takes two arguments: a
 125 project descriptor and a string containing the subject of the message.
 126 This function must prepare a mail buffer.  If you want to do this, please
 127 see how it's done for the built-in methods."
 128   "Mail method"
 129   '(choice (const compose-mail)
 130            (const sendmail)
 131            (const message)
 132            (const gnus)
 133            (const fake)
 134            (symbol :tag "other")))
 135
 136 (patcher-define-project-option user-name nil
 137   "*Default user full name to use when sending a Patcher mail.
 138
 139 If nil, `user-full-name' is used."
 140   "User name"
 141   (patcher-string-or-nil-custom-type "user-full-name"))
 142
 143 (patcher-define-project-option user-mail nil
 144   "*Default user mail address to use when sending a Patcher mail.
 145
 146 If nil, `user-mail-address' is used."
 147   "User mail"
 148   (patcher-string-or-nil-custom-type "user-mail-address"))
 149
 150 (patcher-define-project-option to-address nil
 151   "*Default To: header value to use when sending a Patcher mail.
 152
 153 This variable is used by all mail methods except the 'gnus one \(see
 154 `patcher-default-mail-method').  If nil, it is prompted for."
 155   "To: address"
 156   +patcher-string-or-ask-custom-type+)
 157
 158 (patcher-define-project-option gnus-group nil
 159   "*Default Gnus group to use when sending a Patcher mail.
 160
 161 This variable is used only in the 'gnus mail method \(see
 162 `patcher-default-mail-method').  The mail sending process will behave as if
 163 you had typed `C-u a' in the group buffer on that Gnus group.  If nil,
 164 it is prompted for."
 165   "Gnus group"
 166   +patcher-string-or-ask-custom-type+)
 167
 168 (patcher-define-project-option subject-prefix "[PATCH]"
 169   "*Default prefix for the subject of Patcher mails.
 170
 171 The following string transformations are performed:
 172 - %n: the value of the :name project option if set, or the project's name
 173       in the Patcher sense.
 174 - %N: the project's name in the Patcher sense.
 175
 176 A space will be inserted between the prefix and the rest of the subject,
 177 as appropriate.  This part of the subject is never prompted for.  See
 178 also `patcher-default-subject' and
 179 `patcher-default-subject-committed-prefix'."
 180   "Subject prefix"
 181   +patcher-string-or-none-custom-type+)
 182
 183 (patcher-define-project-option subject-committed-prefix "[COMMIT]"
 184   "*Default prefix for the subject of Patcher mails.
 185
 186 Same as `patcher-default-subject-prefix', but for committed patches.
 187 If nil, keep the normal subject prefix."
 188   "Subject committed prefix"
 189   (patcher-string-or-nil-custom-type "Don't change"))
 190
 191 (patcher-define-project-option subject nil
 192   "*Default subject for Patcher mails.
 193
 194 The following string transformations are performed:
 195 - %n: the value of the :name project option if set, or the project's name
 196       in the Patcher sense.
 197 - %N: the project's name in the Patcher sense.
 198
 199 Please note that this is used *only* to provide a default value for prompted
 200 subjects.  Subjects are *always* prompted for.
 201
 202 See also `patcher-default-subject-prefix' and
 203 `patcher-default-subject-committed-prefix', which are not subject to
 204 prompting."
 205   "Subject"
 206   +patcher-string-or-none-custom-type+)
 207
 208 (patcher-define-project-option subject-rewrite-format "%s (was: %S)"
 209   "*Default rewrite format for adapted subject headers.
 210
 211 This rewrite format is applied every time a mail is \"adapted\",
 212 i.e. explicit adaptation, reply, followup etc., unless the subject
 213 header is empty. In that case, only the new subject is used.
 214
 215 The following string transformations are performed:
 216 - %s: the value of the new subject line,
 217 - %S: the value of the old subject line."
 218   "Subject rewrite format"
 219   'string)
 220
 221 (patcher-define-project-option mail-prologue nil
 222   "*Default prologue for every Patcher mail."
 223   "Mail prologue"
 224   +patcher-string-or-none-custom-type+)
 225
 226 (patcher-define-project-option change-logs-status 'persistent
 227   "*Default ChangeLogs status.
 228
 229 Possible values and their meaning are:
 230 - 'persistent: \(the default) ChangeLog entries are stored in files that
 231    belong to the projet.
 232 - 'ephemeral: ChangeLog entries are not stored permanently in files; they
 233    last only for as long as a project exists, typically to be used in commit
 234    log messages or inserted in mails."
 235   "ChangeLogs status"
 236   '(radio (const :tag "Persistent" persistent)
 237           (const :tag "Ephemeral" ephemeral)))
 238
 239 (patcher-define-project-option change-logs-updating 'automatic
 240   "*Default ChangeLogs updating mode.
 241
 242 Possible values and their meaning are:
 243 - 'automatic: \(the default) Patcher generates ChangeLog skeletons
 244    automatically based on the created diff (you then have to fill up the
 245    entries as needed).
 246 - 'manual: you are supposed to have updated the ChangeLog files by hand,
 247    prior to calling Patcher.
 248 -  nil: you don't do ChangeLogs at all."
 249   "ChangeLogs updating"
 250   '(radio (const :tag "Automatic" automatic)
 251           (const :tag "Manual" manual)
 252           (const :tag "None" nil)))
 253
 254 (patcher-define-project-option change-log-file-name "ChangeLog"
 255   "*Default name for ChangeLog files."
 256   "ChangeLog file name"
 257   'string)
 258
 259 (patcher-define-project-option change-logs-user-name nil
 260   "*Default user full name for generated ChangeLog entries.
 261
 262 If nil, let `patch-to-change-log' decide what to use.
 263 Otherwise, it should be a string."
 264   "ChangeLogs user name"
 265   +patcher-string-or-default-custom-type+)
 266
 267 (patcher-define-project-option change-logs-user-mail nil
 268   "*Default user mail address for generated ChangeLog entries.
 269
 270 If nil, let `patch-to-change-log' decide what to use.
 271 Otherwise, it should be a string."
 272   "ChangeLogs user mail"
 273   +patcher-string-or-default-custom-type+)
 274
 275 (patcher-define-project-option change-logs-appearance 'verbatim
 276   "*Default appearance of ChangeLog entries in Patcher mails.
 277
 278 The values currently supported are:
 279 - 'verbatim \(the default): ChangeLog entries appear simply as text above
 280    the patch.  A short line mentioning the ChangeLog file they belong to
 281    is added when necessary.
 282 - 'pack: ChangeLog files are diff'ed, but the output is packed above the
 283    rest of the patch.
 284 - 'patch: ChangeLog files are diff'ed, and the output appears as part of
 285    the patch itself.
 286 -  nil: ChangeLog entries don't appear at all.
 287
 288 See also the `patcher-default-change-logs-diff-command' user option."
 289   "ChangeLogs appearance"
 290   '(radio (const :tag "Verbatim" verbatim)
 291           (const :tag "Diff, packed together" pack)
 292           (const :tag "Diff, part of the patch" patch)
 293           (const :tag "Don't appear in message" nil)))
 294
 295 (patcher-define-project-option change-logs-prologue "%f addition:"
 296   "*Default ChangeLogs prologue for every Patcher mail.
 297
 298 This applies when ChangeLog additions appear verbatim in the message.
 299 A %f occurring in this string will be replaced with the ChangeLog file name
 300 \(relative to the project's directory)."
 301   "ChangeLogs prologue"
 302   +patcher-string-or-none-custom-type+)
 303
 304 (defun* patcher-default-diff-prologue
 305     (name kind &key source-diff change-log-diff source-files change-log-files)
 306   ;; Default function for inserting a diff prologue.
 307   (ecase kind
 308     (:sources
 309      (insert name " source patch:\n"
 310              "Diff command:   " source-diff "\n"
 311              "Files affected: " source-files "\n"
 312              "\n"))
 313     (:change-logs
 314      (insert name " ChangeLog patch:\n"
 315              "Diff command:   " change-log-diff "\n"
 316              "Files affected: " change-log-files "\n"
 317              "\n"))
 318     (:mixed
 319      (insert name " mixed patch:\n")
 320      (if (not change-log-diff)
 321          (insert "Diff command:             " source-diff "\n"
 322                  "ChangeLog files affected: " change-log-files "\n"
 323                  "Source files affected:    " source-files "\n")
 324        (insert "ChangeLog files diff command: " change-log-diff "\n"
 325                "Files affected:               " change-log-files "\n"
 326                "Source files diff command:    " source-diff "\n"
 327                "Files affected:               " source-files "\n"))
 328      (insert "\n"))))
 329
 330 (patcher-define-project-option diff-prologue-function
 331     'patcher-default-diff-prologue
 332   "*Default function used to insert a prologue before each diff output.
 333
 334 Insertion must occur at current point in current buffer.
 335
 336 The Common Lisp style lambda-list of this function is as follows:
 337 \(NAME KIND &KEY SOURCE-DIFF CHANGE-LOG-DIFF SOURCE-FILES CHANGE-LOG-FILES)
 338
 339 - NAME is the name of the current project,
 340 - KIND is the kind of diff:
 341   * a value of :sources indicates a source diff only,
 342   * a value of :change-logs indicates a ChangeLog diff only,
 343   * a value of :mixed indicates a diff of both source and ChangeLog files.
 344
 345 The key arguments will be bound when appropriate:
 346 - SOURCE-DIFF: the command used to create a source diff,
 347 - CHANGE-LOG-DIFF: the command used to create a ChangeLog diff,
 348 - SOURCE-FILES: sources files affected by the current patch,
 349 - CHANGE-LOG-FILES: ChangeLog files affected by the current patch.
 350
 351 In the case of a :mixed diff, a nil value for CHANGE-LOG-DIFF indicates
 352 that the same command was used for both the source and ChangeLog files."
 353   "Diff prologue function"
 354   '(choice (const :tag "Default" patcher-default-diff-prologue)
 355            (const :tag "None" nil)
 356            (symbol :tag "Other")))
 357
 358 (patcher-define-project-option command-directory nil
 359   "*Default command directory for Patcher projects.
 360
 361 This directory (a string) can be relative to the project's directory.
 362 All diff and commit commands are executed from this directory if set.
 363 Otherwise, the project's directory is used."
 364   "Command directory"
 365   '(choice (const :tag "Same directory" nil)
 366            (string :tag "Other directory")))
 367
 368 (patcher-define-project-option pre-command nil
 369   "*Default string to prefix patcher commands with.
 370
 371 This is where you would put things like \"runsocks\"."
 372   "Pre-command"
 373   +patcher-string-or-none-custom-type+)
 374
 375 (patcher-define-project-option diff-command nil
 376   "*Default method used by Patcher to generate a patch.
 377
 378 The following string transformations are performed:
 379 - %n: the value of the :name project option if set, or the project's name
 380       in the Patcher sense.
 381 - %N: the project's name in the Patcher sense.
 382 - %f: the files affected by the patch.  These files can be specified by
 383       using `patcher-mail-subproject' instead of `patcher-mail' to prepare
 384       the patch.  Otherwise, the %f will simply be removed."
 385   "Diff command"
 386   +patcher-string-or-none-custom-type+
 387   ;; #### NOTE: nil forbidden in project options.
 388   'string)
 389
 390 (patcher-define-project-option ignore-diff-status nil
 391   "*Whether to ignore the exit status returned by the diff command.
 392
 393 It is only useful to set this option to t for CVS, which has this
 394 incredibly stupid idea of returning 1 if there was a diff and 0 otherwise."
 395   "Ignore diff status"
 396   'boolean)
 397
 398 (defun* patcher-default-diff-cleaner
 399     (diff-header &aux (regexp         (nth 0 diff-header))
 400                       (old-file-match (nth 1 diff-header))
 401                       (new-file-match (nth 2 diff-header)))
 402   "Patcher default post-processor for diffs.
 403
 404 This function cleans up RCS-specific diff output (as parsed by the
 405 :diff-header project option) to make it look like a standard one."
 406   (while (re-search-forward regexp nil t)
 407     (replace-match
 408      (concat "--- \\" (number-to-string old-file-match) "\n"
 409              "+++ \\" (number-to-string new-file-match)))))
 410
 411 (patcher-define-project-option diff-cleaner 'patcher-default-diff-cleaner
 412   "*Default function used for cleaning up a diff.
 413
 414 This function is used to transform RCS-specific diff outputs into
 415 something more standard, that `patch-to-change-log' can handle."
 416   "Diff cleaner"
 417   '(choice (const :tag "None" nil)
 418            function))
 419
 420 (patcher-define-project-option diff-header nil
 421   "*Default diff header used by Patcher to determine the diff'ed file.
 422
 423 This variable is of the form (REGEXP . NUMBER). REGEXP is used to match
 424 the beginning of a diff output, and NUMBER is the parenthesized level in
 425 which to find the file name.
 426
 427 The default value is suitable for a Unix unified diff command output,
 428 although file names with spaces are not supported."
 429   "Diff header"
 430   '(choice (const :tag "None" nil)
 431            (list regexp
 432                  (integer :tag "Old file match number")
 433                  (integer :tag "New file match number")))
 434   ;; #### NOTE: nil forbidden in project options.
 435   '(list regexp
 436          (integer :tag "Old file match number")
 437          (integer :tag "New file match number")))
 438
 439 (patcher-define-project-option after-diff-hook nil
 440   "*Default hook run on the output of a Patcher diff comand.
 441
 442 The functions in this hook should operate on the current buffer and
 443 take two optional arguments limiting the processing to a buffer region.
 444 In the absence of arguments, the whole buffer should be processed.
 445
 446 Functions in this hook should take care of saving the excursion."
 447   "After diff hook"
 448   'hook)
 449
 450 (patcher-define-project-option link-change-log-hook nil
 451   "*Default hook run every time Patcher links a new ChangeLog file.
 452
 453 Linking a ChangeLog file in this context means figuring out that it is
 454 involved in the current patch. Every function in this hook hook will be
 455 given the ChangeLog file name, relative to the project's directory, as
 456 argument."
 457   "Notice ChangeLog hook"
 458   'hook)
 459
 460 (patcher-define-project-option after-save-change-log-hook nil
 461   "*Default hook run after a ChangeLog file is saved.
 462
 463 The functions in this hook are executed in the ChangeLog's buffer."
 464   "After save ChangeLog hook"
 465   'hook)
 466
 467 (patcher-define-project-option diff-line-filter nil
 468   "*Default line filter to pass Patcher diffs through.
 469
 470 When inserting a diff in Patcher mails, lines matching this regexp will
 471 be excluded.
 472
 473 Note: the regexp must match the whole line.  Don't add beginning and end
 474 of line markers to it, Patcher will do this for you.
 475
 476 A value of nil (the default) means no line filter."
 477   "Diff line filter"
 478   +patcher-string-or-none-custom-type+)
 479
 480 (patcher-define-project-option change-logs-diff-command nil
 481   "*Default command to use to generate ChangeLog diffs.
 482
 483 This value is used when the ChangeLog appearance is either 'pack or
 484 'patch (see the variable `patcher-default-change-logs-appearance').
 485
 486 If set to 'diff (the default), use the same command as for the rest of the
 487 patch. Otherwise, it should be a string.
 488
 489 The following string transformations are performed:
 490 - %n: the value of the :name project option if set, or the project's name
 491       in the Patcher sense.
 492 - %N: the project's name in the Patcher sense.
 493 - %f: the ChangeLog filenames.
 494
 495 Note: it is highly recommended to remove the context from ChangeLog diffs
 496 because they often fail to apply correctly."
 497   "ChangeLogs diff command"
 498   (patcher-string-or-nil-custom-type "Normal diff command"))
 499
 500 (patcher-define-project-option commit-privilege nil
 501   "*Default value for Patcher commit privilege status.
 502
 503 If you have the privilege to commit patches yourself, you should set
 504 this option to t."
 505   "Commit privilege"
 506   'boolean)
 507
 508 (patcher-define-project-option commit-command nil
 509   "*Default method used by Patcher to commit a patch.
 510
 511 The following string transformations are performed:
 512 - %n: the value of the :name project option if set, or the project's name
 513       in the Patcher sense.
 514 - %N: the project's name in the Patcher sense.
 515 - %s: the name of a file containing the commit log message.
 516 - %S: the commit log message itself (quoted to prevent shell expansion).
 517 - %f: the files affected by the patch.  These files can be specified by using
 518      `patcher-mail-subproject' instead of `patcher-mail' to prepare the patch.
 519       Otherwise, the %f will simply be removed.
 520
 521 - %?f{xxx}: this construct is an \"if %f\" form: if %f expands to something,
 522             this construct expands to `xxx'. Otherwise, its value is
 523             discarded. See the `git' built-in themes for an example of use
 524             (in `patcher-built-in-themes').
 525 - %!f{xxx}: this construct is an \"if not %f\" form: if %f expands to nothing,
 526             this construct expands to `xxx'. Otherwise, its value is
 527             discarded. See the `git' built-in themes for an example of use
 528             (in `patcher-built-in-themes')."
 529   "Commit command"
 530   +patcher-string-or-none-custom-type+
 531   ;; #### NOTE: nil forbidden in project options.
 532   'string)
 533
 534 (patcher-define-project-option edit-commit-command t
 535   "*Whether Patcher lets you edit the commit command by default."
 536   "Edit commit command"
 537   'boolean)
 538
 539 (patcher-define-project-option committed-notice
 540   "NOTE: This patch has been committed."
 541   "*Default notice added to a mail after a commit."
 542   "Committed notice"
 543   +patcher-string-or-none-custom-type+)
 544
 545 (patcher-define-project-option failed-command-regexp nil
 546   "*Default regular expression for matching the result of a failed command.
 547
 548 Commands in question are the diff and the commit one."
 549   "Failed command regexp"
 550   '(choice (const :tag "None" nil)
 551            regexp))
 552
 553 (patcher-define-project-option log-message-items '(subject)
 554   "*Default elements used to initialize a Patcher commit log message.
 555
 556 This is nil, or a list of the following items:
 557 - 'subject: the subject of the corresponding Patcher mail (sans the prefix),
 558 - 'compressed-change-logs: the compressed ChangeLog entries for the current
 559    patch.
 560 - 'change-logs: the ChangeLog entries for the current patch.  If some items
 561    appear before the ChangeLog entries, the ChangeLogs separator will
 562    automatically be included."
 563   "Log message items"
 564   '(set (const :tag "Subject" subject)
 565         (const :tag "Compressed ChangeLogs" compressed-change-logs)
 566         (const :tag "ChangeLogs" change-logs)))
 567
 568 (patcher-define-project-option change-logs-separator
 569   "-------------------- ChangeLog entries follow: --------------------"
 570   "*Default ChangeLog entries separator for Patcher commit log messages.
 571
 572 Either nil, or a string which will be inserted in a line of its own.
 573
 574 See also the function `patcher-logmsg-insert-change-logs'."
 575   "ChangeLogs separator"
 576   +patcher-string-or-none-custom-type+)
 577
 578 (patcher-define-project-option edit-log-message t
 579   "*Whether Patcher lets you edit the commit log message by default.
 580
 581 If nil, Patcher will directly use the initialization value \(see
 582 `patcher-default-init-log-message')."
 583   "Edit log message"
 584   'boolean)
 585
 586 (patcher-define-project-option kill-sources-after-sending t
 587   "*Whether to kill source files after sending the mail by default."
 588   "Kill source files after sending"
 589   'boolean)
 590
 591 (patcher-define-project-option kill-change-logs-after-sending t
 592   "*Whether to kill the ChangeLog files after sending the mail by default."
 593   "Kill ChangeLogs after sending"
 594   'boolean)
 595
 596 (patcher-define-project-option check-change-logs-insertion 'ask
 597   "*Whether to check for ChangeLogs insertion checking prior to sending.
 598
 599 This option affects the behavior of Patcher when ChangeLogs are supposed
 600 to appear by manual insertion into the mail buffer.
 601 - If nil, Patcher never checks and lets you send the message as-is.
 602 - If t, Patcher blindly aborts the sending process if you have forgotten
 603   to insert the ChangeLogs in the message buffer.
 604 - If 'ask (the default), Patcher asks you whether you want to proceed with
 605   sending or not."
 606   "Check for ChangeLogs insertion before sending"
 607   '(radio (const :tag "Never check" nil)
 608           (const :tag "Abort sending upon omission" t)
 609           (const :tag "Ask the user" ask)))
 610
 611 (patcher-define-project-option check-commit 'ask
 612   "*Whether to check for a commit prior to sending.
 613
 614 This option affects the behavior of Patcher when you have set the
 615 :commit-privilege project option.
 616 - If nil, Patcher never checks and lets you send the message as-is.
 617 - If t, Patcher blindly aborts the sending process if you have forgotten
 618   to commit your changes.
 619 - If 'ask (the default), Patcher asks you whether you want to proceed with
 620   sending or not."
 621   "Check for commit before sending"
 622   '(radio (const :tag "Never check" nil)
 623           (const :tag "Abort sending upon omission" t)
 624           (const :tag "Ask the user" ask)))
 625
 626 (patcher-define-project-option submodule-detection-function nil
 627   "*The name of a submodule automatic detection function, or nil."
 628   "Detect submodules"
 629   '(choice :value nil
 630     (const :tag "Detect Mercurial submodules" patcher-hg-detect-submodules)
 631     (symbol :tag "Other")
 632     (const :tag "Don't detect submodules" nil)))
 633
 634
 635 ;; #### NOTE: ideally, this type should be computed automatically, depending
 636 ;; on the defined themes. This arises the interesting question of custom
 637 ;; dynamic types. Without them, it's a complex thing to do.
 638 (patcher-define-project-option themes nil
 639   "*Default themes to use in Patcher projects.
 640
 641 This is a list of theme names (symbols) that must be defined either
 642 in `patcher-themes' or `patcher-built-in-themes'."
 643   "Themes"
 644   '(repeat (symbol :tag "Theme name")))
 645
 646 ;; This used to be pushed at the end of +patcher-project-options-custom-type+,
 647 ;; but is currently useless, and would cause problems in the custom type: it
 648 ;; will match the inheritance field in patcher-projects before the
 649 ;; corresponding custom type definition.
 650 ;;    (list :inline t :tag "Other"
 651 ;;        symbol
 652 ;;        sexp))
 653
 654 ;; Defining these constants avoids coding special cases for the :inheritance,
 655 ;; :subdirectory and :files (sub)project option in the accessor functions.
 656 (defconst patcher-default-inheritance nil)
 657 (defconst patcher-default-subdirectory nil)
 658 (defconst patcher-default-files nil)
 659
 660
 661
 662 \f
 663 ;; ===========================================================================
 664 ;; Themes
 665 ;; ===========================================================================
 666
 667 (defgroup patcher-themes nil
 668   "Patcher settings for themes."
 669   :group 'patcher)
 670
 671 (defcustom patcher-themes ()
 672   "*List of themes to use in Patcher projects.
 673
 674 Each element looks like \(NAME :OPTION VALUE ...).  NAME is the theme
 675 name (a symbol).  The remainder of the list is the same as in project
 676 descriptors (see `patcher-projects').
 677
 678 Themes are searched for respectively in this variable and in
 679 `patcher-built-in-themes'.
 680
 681 See also `patcher-max-theme-depth'."
 682   :group 'patcher-themes
 683   :type `(repeat
 684           (group (symbol :tag "Theme name")
 685                  ;; #### NOTE: we could be tempted to add an `inheritance'
 686                  ;; mechanism for themes, just like for projects. However,
 687                  ;; don't forget that a theme can contain other themes because
 688                  ;; themes belong to `+patcher-project-options-custom-type+'.
 689                  (repeat :inline t :tag "Options"
 690                          (choice :inline t :value (:mail-method compose-mail)
 691                                  ,@+patcher-project-options-custom-type+)))))
 692
 693 (defconst patcher-built-in-themes nil
 694   "List of predefined themes.
 695 You can add new ones or override these ones in `patcher-themes'.")
 696
 697 (defun patcher-themes ()
 698   ;; Return the concatenation of user defined and built-in themes.
 699   (append patcher-themes patcher-built-in-themes))
 700
 701 (defun patcher-theme (name)
 702   ;; Return the theme named NAME.
 703   (assoc name (patcher-themes)))
 704
 705
 706 ;; Accessors ================================================================
 707
 708 (defvaralias 'patcher-max-theme-depth 'patcher-theme-max-depth)
 709 (defcustom patcher-theme-max-depth 8
 710   "*Maximum nesting level in Patcher themes.
 711
 712 This option is a guard against infinite loops that might occur for wrong
 713 settings of Patcher themes (as themes can contain themes)."
 714   :group 'patcher-themes
 715   :type 'integer)
 716
 717 (defun patcher-theme-name (theme)
 718   ;; Return THEME's name
 719   (car theme))
 720
 721 (defun patcher-theme-options (theme)
 722   ;; Return THEME's option list.
 723   (cdr theme))
 724
 725 ;; #### NOTE: looking depth-first for options not directly available might not
 726 ;; be the best choice.
 727 (defun* patcher-themes-option (theme-names option level
 728                                &aux theme-name theme value)
 729   ;; Look for OPTION in THEME-NAMES, no deeper than LEVEL.
 730   ;; Note that themes can have the :themes option set. Options are looked for
 731   ;; by depth first.
 732   (while (and (not value) (setq theme-name (pop theme-names)))
 733     (setq theme (patcher-theme theme-name))
 734     (or theme (patcher-error "`%s': no such theme" theme-name))
 735     (let ((theme-options (patcher-theme-options theme)))
 736       (setq value (member option theme-options))
 737       (unless value
 738         (let ((subthemes (member :themes theme-options)))
 739           (when (> level patcher-theme-max-depth)
 740             (patcher-error "\
 741 Theme `%s': maximum nesting level of themes exceeded.
 742 Either you have an infinite loop in your theme's :themes option, or you should
 743 increase the value of `patcher-max-theme-depth'"
 744                            (patcher-theme-name theme)))
 745           (setq value
 746                 (patcher-themes-option
 747                  (cadr subthemes) option (1+ level)))))))
 748   value)
 749
 750
 751
 752 \f
 753 ;; ===========================================================================
 754 ;; Projects, subprojects and submodules
 755 ;; ===========================================================================
 756
 757 (defgroup patcher-projects nil
 758   "Patcher settings for projects."
 759   :group 'patcher)
 760
 761 (defcustom patcher-projects ()
 762   "*List of project descriptors.
 763
 764 Each project descriptor looks like \(NAME DIR :OPTION VALUE ...).
 765 - NAME is the project's name \(a string).
 766 - DIR is the project's root directory (a string, or nil for prompting).
 767
 768 The remainder of the project descriptor is composed of \"project options\"
 769 \(keyword / value pairs).  When Patcher needs a project option, it tries
 770 to find it at different places:
 771 - First, it looks for it in the project descriptor itself.
 772 - If that fails, it tries to find it in the project themes, if any.
 773 - If that fails, it tries to find it in the inherited projects, if any.
 774 - If that fails, it falls back to the corresponding `patcher-default-*'
 775   user option."
 776   :group 'patcher-projects
 777   :type `(repeat
 778           (group (string :tag "Project")
 779                  (choice :tag "Directory" :value nil
 780                          (const :tag "Prompt" :value nil)
 781                          (directory :tag ""))
 782                  (repeat :inline t :tag "Options"
 783                          (choice :inline t :value (:mail-method compose-mail)
 784                                  ,@+patcher-project-options-custom-type+
 785                                  (list :inline t :tag "Inheritance"
 786                                        :format "%{%t%}: %v"
 787                                        (const :tag "" :value :inheritance)
 788                                        (repeat :tag "From"
 789                                                (string :tag "Project"))))))))
 790
 791 ;; #### FIXME: this whole notion of subproject needs to be rethought. We
 792 ;; shouldn't need to keep subprojects separately. The :subdirectory and :files
 793 ;; options could be common options like the other ones, and :subdirectory
 794 ;; could then refer to either the first superproject in :inherit, or a
 795 ;; separate :superproject option.
 796 (defcustom patcher-subprojects ()
 797   "*List of Patcher subproject descriptors.
 798
 799 Subproject descriptors are similar to project descriptors \(see the
 800 variable `patcher-projects') with a few exceptions:
 801
 802 - Instead of the project directory field DIR, you specify the name of the
 803   project this subproject is based on.
 804 - Two project options are available in addition to the standard ones:
 805   - :subdirectory lets you specify a subdirectory \(of the parent
 806      project's directory) in which the whole subproject resides.  There is
 807      no corresponding `patcher-default-subdirectory' fallback..
 808   - :files lets you specify a list of files or directories composing the
 809      subproject.  Each file specification can contain wildcards.  If a
 810      :subdirectory option is given, these files or directories should be
 811      relative to this subdirectory.  Otherwise, they should be relative to
 812      the base project's directory.  There is no corresponding
 813      `patcher-default-files' variable.
 814   Note that a subproject with neither a :subdirectory nor a :files option
 815   behaves exactly like the corresponding base project.
 816 - Subprojects don't have an :inheritance mechanism.  Instead, they
 817   implicitly inherit from their base project \(which in turn can inherit
 818   from other projects).
 819
 820 Note: the normal way to use predefined Patcher subprojects is to call
 821 `patcher-mail', *not* `patcher-mail-subproject'.  Using the former will
 822 directly use the set of files and/or directory you have specified.  Using
 823 the latter will also let you modify this set."
 824   :group 'patcher-projects
 825   :type `(repeat
 826           (group (string :tag "Subproject")
 827                  (string :tag "Of project")
 828                  (repeat :inline t :tag "Options"
 829                          (choice :inline t :value (:subdirectory "")
 830                                  ;; #### Look inside the widget library to see
 831                                  ;; #### how we can modify the completion
 832                                  ;; #### behavior
 833                                  (list :inline t :tag "Subdirectory"
 834                                        :format "%{%t%}: %v"
 835                                        (const :tag "" :value :subdirectory)
 836                                        directory)
 837                                  (list :inline t :tag "Files"
 838                                        :format "%{%t%}: %v"
 839                                        (const :tag "" :value :files)
 840                                        (repeat :format "\n%v%i\n" file))
 841                                  ,@+patcher-project-options-custom-type+)))))
 842
 843 (defvar patcher-submodules nil
 844   ;; The list of automatically detected submodules
 845   )
 846
 847
 848 ;; Accessors ================================================================
 849
 850 (defun patcher-subproject-p (descriptor)
 851   ;; Return non nil if DESCRIPTOR is defined in `patcher-subprojects'.
 852   (member descriptor patcher-subprojects))
 853
 854 (defun patcher-superproject-name (descriptor)
 855   ;; Return subproject DESCRIPTOR's super-project name.
 856   (assert (patcher-subproject-p descriptor))
 857   (nth 1 descriptor))
 858
 859 (defun patcher-descriptor-name (descriptor)
 860   ;; Return DESCRIPTOR's name, which is different from its potential :name
 861   ;; option. This works for either project or subproject descriptors.
 862   (nth 0 descriptor))
 863
 864 (defun* patcher-descriptor-directory
 865     (descriptor
 866      &aux (directory (if (patcher-subproject-p descriptor)
 867                          (let ((superproject
 868                                 (assoc (patcher-superproject-name descriptor)
 869                                        patcher-projects)))
 870                            (unless superproject
 871                              (patcher-error
 872                               "Can't find base project for subproject `%s'"
 873                               (patcher-descriptor-name descriptor)))
 874                            (nth 1 superproject))
 875                        (nth 1 descriptor))))
 876   ;; Return the directory of DESCRIPTOR as a file name.
 877   ;; If DESCRIPTOR describes a subproject, return the superproject's
 878   ;; directory.
 879   (when directory
 880     (directory-file-name directory)))
 881
 882 (defun patcher-descriptor-options (descriptor)
 883   ;; Return DESCRIPTOR's options list.
 884   (cddr descriptor))
 885
 886 ;; #### NOTE: Project options accessors don't handle the case where the same
 887 ;; option is given several times. Only the first one is used, which is the
 888 ;; only sensible thing to do anyway.
 889
 890 (defcustom patcher-max-inheritance-depth 8
 891   "*Maximum nesting level in Patcher projects.
 892
 893 This option is a guard against infinite loops that might occur for wrong
 894 settings of Patcher projects (as projects can inherit projects)."
 895   :group 'patcher-projects
 896   :type 'integer)
 897
 898 (defun* patcher-descriptor-option
 899     (descriptor option level
 900      &aux (name (patcher-descriptor-name descriptor))
 901           (subprojectp (patcher-subproject-p descriptor)))
 902   ;; Look for OPTION in DESCRIPTOR, at current nesting LEVEL.
 903   ;; If not found, try to find it in a theme or in the (sub)project's
 904   ;; inheritance tree.
 905   ;; Return the whole option form: '(:option value)
 906   ;; #### NOTE: the :inheritance option is illegal in subprojects and it is
 907   ;; just ignored. Conversely, the :subdirectory and :files options are
 908   ;; illegal in regular projects, and they are also ignored. This function
 909   ;; just returns nil in such cases, which makes sense for blind calls which
 910   ;; don't know if they are working on regular or subprojects.
 911   (unless (and (member option '(:subdirectory :files))
 912                (not subprojectp))
 913     (when (> level patcher-max-inheritance-depth)
 914       (patcher-error "\
 915 Project `%s': maximum nesting level of projects exceeded.
 916 Either you have an infinite loop in your project's inheritance, or you should
 917 increase the value of `patcher-max-inheritance-depth'"
 918                      name))
 919     (let* ((options (patcher-descriptor-options descriptor))
 920            (value (member option options)))
 921       (unless value
 922         ;; Try to find the option in a theme.
 923         (let ((themes (member :themes options)))
 924           (when themes
 925             (setq value (patcher-themes-option (cadr themes) option 0)))))
 926       (unless value
 927         ;; Try to find the option in inherited projects. Note that inherited
 928         ;; projects can have their :inherit option set in turn.
 929         (let ((project-names (if subprojectp
 930                                  (list (patcher-superproject-name descriptor))
 931                                  (cadr (member :inheritance options))))
 932               project-name)
 933           (when project-names
 934             (while (and (not value) (setq project-name (pop project-names)))
 935                    (setq value (patcher-descriptor-option
 936                                 (assoc project-name patcher-projects)
 937                                 option (1+ level)))))))
 938       value)))
 939
 940
 941 ;; Prompting ================================================================
 942
 943 (defun patcher-detect-submodules ()
 944   "Scan PATCHER-PROJECTS and detect potential submodules automatically."
 945   (interactive)
 946   (setq patcher-submodules nil)
 947   (dolist (descriptor patcher-projects)
 948     (when (nth 1 descriptor)
 949       (let ((detection-function
 950              (or (cadr (patcher-descriptor-option descriptor
 951                          :submodule-detection-function 0))
 952                  patcher-default-submodule-detection-function)))
 953         (when detection-function
 954           (let ((submodules (funcall detection-function (nth 1 descriptor))))
 955             (dolist (submodule submodules)
 956               (push (list (format "%s (%s)" (car descriptor) (car submodule))
 957                           (expand-file-name (cadr submodule)
 958                                             (nth 1 descriptor))
 959                           :inheritance (list (car descriptor)))
 960                     patcher-submodules))))))))
 961
 962 (defun patcher-project-descriptors ()
 963   ;; Return the list of submodule, subproject and project descriptors.
 964   (let ((user-projects (append patcher-subprojects patcher-projects)))
 965     (unless patcher-submodules
 966       (patcher-detect-submodules))
 967     (if (eq patcher-submodules t)
 968         user-projects
 969       (append user-projects patcher-submodules))))
 970
 971 (defun patcher-project-descriptor (name)
 972   ;; Return the project descriptor for NAME.
 973   (assoc name (patcher-project-descriptors)))
 974
 975
 976 (defvar patcher-project-name-history nil)
 977
 978 (defun* patcher-prompt-name
 979     (&aux (descriptors (patcher-project-descriptors)) name)
 980   ;; Prompt for, and return a project name.
 981   ;; Prompting is done with completion and requires a match.
 982   (while (zerop (length (setq name (completing-read "Project: " descriptors
 983                                      nil t nil
 984                                      'patcher-project-name-history))))
 985     (beep))
 986   name)
 987
 988
 989 (provide 'patcher-project)
 990
 991 ;;; patcher-project.el ends here