;;; patcher-project.el --- Project implementation ;; Copyright (C) 2008, 2009, 2010, 2011 Didier Verna ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007 Didier Verna ;; Author: Didier Verna ;; Maintainer: Didier Verna ;; Created: Sat Feb 13 15:02:50 2010 ;; Last Revision: Sun Dec 11 12:16:22 2011 ;; Keywords: maint ;; This file is part of Patcher. ;; Patcher is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License version 3, ;; as published by the Free Software Foundation. ;; Patcher is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program; if not, write to the Free Software ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; Contents management by FCM version 0.1. ;;; Code: (require 'cl) (eval-when-compile (require 'patcher-cutil)) (require 'patcher-util) ;; =========================================================================== ;; Utilities ;; =========================================================================== (defmacro patcher-string-or-nil-custom-type (tag) ;; Creates a string-or-nil custom type with TAG for the nil case. `'(choice (const :tag ,tag nil) string)) (defconst +patcher-string-or-none-custom-type+ (patcher-string-or-nil-custom-type "None")) (defconst +patcher-string-or-ask-custom-type+ (patcher-string-or-nil-custom-type "Ask")) (defconst +patcher-string-or-default-custom-type+ (patcher-string-or-nil-custom-type "Default")) (patcher-define-error 'project-option "Patcher project option error") (patcher-define-error 'invalid-project-option "Patcher invalid project option error" 'project-option) ;; =========================================================================== ;; Project options and fallback variables ;; =========================================================================== (defgroup patcher nil "Automatic archive-base project maintenance.") (defgroup patcher-default nil "Patcher settings for default project options." :group 'patcher) (defvar +patcher-project-options-custom-type+ ()) (put 'patcher-define-project-option 'lisp-indent-function 2) (defmacro* patcher-define-project-option (name default-value docstring tag custom-type &optional (alternate-custom-type custom-type)) ;; Create a project option fallback variable `patcher-default-NAME', and ;; push CUSTOM-TYPE at the end of `+patcher-project-options-custom-type+'. `(progn (patcher-endpush `(list :inline t :tag ,,tag :format "%{%t%}: %v" (const :tag "" :value ,,(intern (concat ":" (symbol-name name)))) ,,alternate-custom-type) +patcher-project-options-custom-type+) (defcustom ,(intern (concat "patcher-default-" (symbol-name name))) ,default-value ,docstring :group 'patcher-default :type ,custom-type))) (patcher-define-project-option name nil "*Default name for Patcher projects. This project option (a string) exists to let you define different Patcher projects (hence with different names) sharing a common name for the underlying diff and commit commands. If set, it will be used rather than the real project's name." "Project name" '(choice (const :tag "Patcher name" nil) (string :tag "Other name"))) (patcher-define-project-option mail-method 'compose-mail "*Default method used by Patcher to prepare a mail. Currently, there are four built-in methods: 'compose-mail \(the default), 'sendmail, 'message, 'gnus and 'fake. Please refer to the corresponding `patcher-mail-*' function for a description of each method. You can also define your own method, say `foo'. In that case, you *must* provide a function named `patcher-mail-foo' which takes two arguments: a project descriptor and a string containing the subject of the message. This function must prepare a mail buffer. If you want to do this, please see how it's done for the built-in methods." "Mail method" '(choice (const compose-mail) (const sendmail) (const message) (const gnus) (const fake) (symbol :tag "other"))) (patcher-define-project-option user-name nil "*Default user full name to use when sending a Patcher mail. If nil, `user-full-name' is used." "User name" (patcher-string-or-nil-custom-type "user-full-name")) (patcher-define-project-option user-mail nil "*Default user mail address to use when sending a Patcher mail. If nil, `user-mail-address' is used." "User mail" (patcher-string-or-nil-custom-type "user-mail-address")) (patcher-define-project-option to-address nil "*Default To: header value to use when sending a Patcher mail. This variable is used by all mail methods except the 'gnus one \(see `patcher-default-mail-method'). If nil, it is prompted for." "To: address" +patcher-string-or-ask-custom-type+) (patcher-define-project-option gnus-group nil "*Default Gnus group to use when sending a Patcher mail. This variable is used only in the 'gnus mail method \(see `patcher-default-mail-method'). The mail sending process will behave as if you had typed `C-u a' in the group buffer on that Gnus group. If nil, it is prompted for." "Gnus group" +patcher-string-or-ask-custom-type+) (patcher-define-project-option subject-prefix "[PATCH]" "*Default prefix for the subject of Patcher mails. The following string transformations are performed: - %n: the value of the :name project option if set, or the project's name in the Patcher sense. - %N: the project's name in the Patcher sense. A space will be inserted between the prefix and the rest of the subject, as appropriate. This part of the subject is never prompted for. See also `patcher-default-subject' and `patcher-default-subject-committed-prefix'." "Subject prefix" +patcher-string-or-none-custom-type+) (patcher-define-project-option subject-committed-prefix "[COMMIT]" "*Default prefix for the subject of Patcher mails. Same as `patcher-default-subject-prefix', but for committed patches. If nil, keep the normal subject prefix." "Subject committed prefix" (patcher-string-or-nil-custom-type "Don't change")) (patcher-define-project-option subject nil "*Default subject for Patcher mails. The following string transformations are performed: - %n: the value of the :name project option if set, or the project's name in the Patcher sense. - %N: the project's name in the Patcher sense. Please note that this is used *only* to provide a default value for prompted subjects. Subjects are *always* prompted for. See also `patcher-default-subject-prefix' and `patcher-default-subject-committed-prefix', which are not subject to prompting." "Subject" +patcher-string-or-none-custom-type+) (patcher-define-project-option subject-rewrite-format "%s (was: %S)" "*Default rewrite format for adapted subject headers. This rewrite format is applied every time a mail is \"adapted\", i.e. explicit adaptation, reply, followup etc., unless the subject header is empty. In that case, only the new subject is used. The following string transformations are performed: - %s: the value of the new subject line, - %S: the value of the old subject line." "Subject rewrite format" 'string) (patcher-define-project-option mail-prologue nil "*Default prologue for every Patcher mail." "Mail prologue" +patcher-string-or-none-custom-type+) (patcher-define-project-option change-logs-status 'persistent "*Default ChangeLogs status. Possible values and their meaning are: - 'persistent: \(the default) ChangeLog entries are stored in files that belong to the projet. - 'ephemeral: ChangeLog entries are not stored permanently in files; they last only for as long as a project exists, typically to be used in commit log messages or inserted in mails." "ChangeLogs status" '(radio (const :tag "Persistent" persistent) (const :tag "Ephemeral" ephemeral))) (patcher-define-project-option change-logs-updating 'automatic "*Default ChangeLogs updating mode. Possible values and their meaning are: - 'automatic: \(the default) Patcher generates ChangeLog skeletons automatically based on the created diff (you then have to fill up the entries as needed). - 'manual: you are supposed to have updated the ChangeLog files by hand, prior to calling Patcher. - nil: you don't do ChangeLogs at all." "ChangeLogs updating" '(radio (const :tag "Automatic" automatic) (const :tag "Manual" manual) (const :tag "None" nil))) (patcher-define-project-option change-log-file-name "ChangeLog" "*Default name for ChangeLog files." "ChangeLog file name" 'string) (patcher-define-project-option change-logs-user-name nil "*Default user full name for generated ChangeLog entries. If nil, let `patch-to-change-log' decide what to use. Otherwise, it should be a string." "ChangeLogs user name" +patcher-string-or-default-custom-type+) (patcher-define-project-option change-logs-user-mail nil "*Default user mail address for generated ChangeLog entries. If nil, let `patch-to-change-log' decide what to use. Otherwise, it should be a string." "ChangeLogs user mail" +patcher-string-or-default-custom-type+) (patcher-define-project-option change-logs-appearance 'verbatim "*Default appearance of ChangeLog entries in Patcher mails. The values currently supported are: - 'verbatim \(the default): ChangeLog entries appear simply as text above the patch. A short line mentioning the ChangeLog file they belong to is added when necessary. - 'pack: ChangeLog files are diff'ed, but the output is packed above the rest of the patch. - 'patch: ChangeLog files are diff'ed, and the output appears as part of the patch itself. - nil: ChangeLog entries don't appear at all. See also the `patcher-default-change-logs-diff-command' user option." "ChangeLogs appearance" '(radio (const :tag "Verbatim" verbatim) (const :tag "Diff, packed together" pack) (const :tag "Diff, part of the patch" patch) (const :tag "Don't appear in message" nil))) (patcher-define-project-option change-logs-prologue "%f addition:" "*Default ChangeLogs prologue for every Patcher mail. This applies when ChangeLog additions appear verbatim in the message. A %f occurring in this string will be replaced with the ChangeLog file name \(relative to the project's directory)." "ChangeLogs prologue" +patcher-string-or-none-custom-type+) (defun* patcher-default-diff-prologue (name kind &key source-diff change-log-diff source-files change-log-files) ;; Default function for inserting a diff prologue. (ecase kind (:sources (insert name " source patch:\n" "Diff command: " source-diff "\n" "Files affected: " source-files "\n" "\n")) (:change-logs (insert name " ChangeLog patch:\n" "Diff command: " change-log-diff "\n" "Files affected: " change-log-files "\n" "\n")) (:mixed (insert name " mixed patch:\n") (if (not change-log-diff) (insert "Diff command: " source-diff "\n" "ChangeLog files affected: " change-log-files "\n" "Source files affected: " source-files "\n") (insert "ChangeLog files diff command: " change-log-diff "\n" "Files affected: " change-log-files "\n" "Source files diff command: " source-diff "\n" "Files affected: " source-files "\n")) (insert "\n")))) (patcher-define-project-option diff-prologue-function 'patcher-default-diff-prologue "*Default function used to insert a prologue before each diff output. Insertion must occur at current point in current buffer. The Common Lisp style lambda-list of this function is as follows: \(NAME KIND &KEY SOURCE-DIFF CHANGE-LOG-DIFF SOURCE-FILES CHANGE-LOG-FILES) - NAME is the name of the current project, - KIND is the kind of diff: * a value of :sources indicates a source diff only, * a value of :change-logs indicates a ChangeLog diff only, * a value of :mixed indicates a diff of both source and ChangeLog files. The key arguments will be bound when appropriate: - SOURCE-DIFF: the command used to create a source diff, - CHANGE-LOG-DIFF: the command used to create a ChangeLog diff, - SOURCE-FILES: sources files affected by the current patch, - CHANGE-LOG-FILES: ChangeLog files affected by the current patch. In the case of a :mixed diff, a nil value for CHANGE-LOG-DIFF indicates that the same command was used for both the source and ChangeLog files." "Diff prologue function" '(choice (const :tag "Default" patcher-default-diff-prologue) (const :tag "None" nil) (symbol :tag "Other"))) (patcher-define-project-option command-directory nil "*Default command directory for Patcher projects. This directory (a string) can be relative to the project's directory. All diff and commit commands are executed from this directory if set. Otherwise, the project's directory is used." "Command directory" '(choice (const :tag "Same directory" nil) (string :tag "Other directory"))) (patcher-define-project-option pre-command nil "*Default string to prefix patcher commands with. This is where you would put things like \"runsocks\"." "Pre-command" +patcher-string-or-none-custom-type+) (patcher-define-project-option diff-command nil "*Default method used by Patcher to generate a patch. The following string transformations are performed: - %n: the value of the :name project option if set, or the project's name in the Patcher sense. - %N: the project's name in the Patcher sense. - %f: the files affected by the patch. These files can be specified by using `patcher-mail-subproject' instead of `patcher-mail' to prepare the patch. Otherwise, the %f will simply be removed." "Diff command" +patcher-string-or-none-custom-type+ ;; #### NOTE: nil forbidden in project options. 'string) (patcher-define-project-option ignore-diff-status nil "*Whether to ignore the exit status returned by the diff command. It is only useful to set this option to t for CVS, which has this incredibly stupid idea of returning 1 if there was a diff and 0 otherwise." "Ignore diff status" 'boolean) (defun* patcher-default-diff-cleaner (diff-header &aux (regexp (nth 0 diff-header)) (old-file-match (nth 1 diff-header)) (new-file-match (nth 2 diff-header))) "Patcher default post-processor for diffs. This function cleans up RCS-specific diff output (as parsed by the :diff-header project option) to make it look like a standard one." (while (re-search-forward regexp nil t) (replace-match (concat "--- \\" (number-to-string old-file-match) "\n" "+++ \\" (number-to-string new-file-match))))) (patcher-define-project-option diff-cleaner 'patcher-default-diff-cleaner "*Default function used for cleaning up a diff. This function is used to transform RCS-specific diff outputs into something more standard, that `patch-to-change-log' can handle." "Diff cleaner" '(choice (const :tag "None" nil) function)) (patcher-define-project-option diff-header nil "*Default diff header used by Patcher to determine the diff'ed file. This variable is of the form (REGEXP . NUMBER). REGEXP is used to match the beginning of a diff output, and NUMBER is the parenthesized level in which to find the file name. The default value is suitable for a Unix unified diff command output, although file names with spaces are not supported." "Diff header" '(choice (const :tag "None" nil) (list regexp (integer :tag "Old file match number") (integer :tag "New file match number"))) ;; #### NOTE: nil forbidden in project options. '(list regexp (integer :tag "Old file match number") (integer :tag "New file match number"))) (patcher-define-project-option after-diff-hook nil "*Default hook run on the output of a Patcher diff comand. The functions in this hook should operate on the current buffer and take two optional arguments limiting the processing to a buffer region. In the absence of arguments, the whole buffer should be processed. Functions in this hook should take care of saving the excursion." "After diff hook" 'hook) (patcher-define-project-option link-change-log-hook nil "*Default hook run every time Patcher links a new ChangeLog file. Linking a ChangeLog file in this context means figuring out that it is involved in the current patch. Every function in this hook hook will be given the ChangeLog file name, relative to the project's directory, as argument." "Notice ChangeLog hook" 'hook) (patcher-define-project-option after-save-change-log-hook nil "*Default hook run after a ChangeLog file is saved. The functions in this hook are executed in the ChangeLog's buffer." "After save ChangeLog hook" 'hook) (patcher-define-project-option diff-line-filter nil "*Default line filter to pass Patcher diffs through. When inserting a diff in Patcher mails, lines matching this regexp will be excluded. Note: the regexp must match the whole line. Don't add beginning and end of line markers to it, Patcher will do this for you. A value of nil (the default) means no line filter." "Diff line filter" +patcher-string-or-none-custom-type+) (patcher-define-project-option change-logs-diff-command nil "*Default command to use to generate ChangeLog diffs. This value is used when the ChangeLog appearance is either 'pack or 'patch (see the variable `patcher-default-change-logs-appearance'). If set to 'diff (the default), use the same command as for the rest of the patch. Otherwise, it should be a string. The following string transformations are performed: - %n: the value of the :name project option if set, or the project's name in the Patcher sense. - %N: the project's name in the Patcher sense. - %f: the ChangeLog filenames. Note: it is highly recommended to remove the context from ChangeLog diffs because they often fail to apply correctly." "ChangeLogs diff command" (patcher-string-or-nil-custom-type "Normal diff command")) (patcher-define-project-option commit-privilege nil "*Default value for Patcher commit privilege status. If you have the privilege to commit patches yourself, you should set this option to t." "Commit privilege" 'boolean) (patcher-define-project-option commit-command nil "*Default method used by Patcher to commit a patch. The following string transformations are performed: - %n: the value of the :name project option if set, or the project's name in the Patcher sense. - %N: the project's name in the Patcher sense. - %s: the name of a file containing the commit log message. - %S: the commit log message itself (quoted to prevent shell expansion). - %f: the files affected by the patch. These files can be specified by using `patcher-mail-subproject' instead of `patcher-mail' to prepare the patch. Otherwise, the %f will simply be removed. - %?f{xxx}: this construct is an \"if %f\" form: if %f expands to something, this construct expands to `xxx'. Otherwise, its value is discarded. See the `git' built-in themes for an example of use (in `patcher-built-in-themes'). - %!f{xxx}: this construct is an \"if not %f\" form: if %f expands to nothing, this construct expands to `xxx'. Otherwise, its value is discarded. See the `git' built-in themes for an example of use (in `patcher-built-in-themes')." "Commit command" +patcher-string-or-none-custom-type+ ;; #### NOTE: nil forbidden in project options. 'string) (patcher-define-project-option edit-commit-command t "*Whether Patcher lets you edit the commit command by default." "Edit commit command" 'boolean) (patcher-define-project-option committed-notice "NOTE: This patch has been committed." "*Default notice added to a mail after a commit." "Committed notice" +patcher-string-or-none-custom-type+) (patcher-define-project-option failed-command-regexp nil "*Default regular expression for matching the result of a failed command. Commands in question are the diff and the commit one." "Failed command regexp" '(choice (const :tag "None" nil) regexp)) (patcher-define-project-option log-message-items '(subject) "*Default elements used to initialize a Patcher commit log message. This is nil, or a list of the following items: - 'subject: the subject of the corresponding Patcher mail (sans the prefix), - 'compressed-change-logs: the compressed ChangeLog entries for the current patch. - 'change-logs: the ChangeLog entries for the current patch. If some items appear before the ChangeLog entries, the ChangeLogs separator will automatically be included." "Log message items" '(set (const :tag "Subject" subject) (const :tag "Compressed ChangeLogs" compressed-change-logs) (const :tag "ChangeLogs" change-logs))) (patcher-define-project-option change-logs-separator "-------------------- ChangeLog entries follow: --------------------" "*Default ChangeLog entries separator for Patcher commit log messages. Either nil, or a string which will be inserted in a line of its own. See also the function `patcher-logmsg-insert-change-logs'." "ChangeLogs separator" +patcher-string-or-none-custom-type+) (patcher-define-project-option edit-log-message t "*Whether Patcher lets you edit the commit log message by default. If nil, Patcher will directly use the initialization value \(see `patcher-default-init-log-message')." "Edit log message" 'boolean) (patcher-define-project-option kill-sources-after-sending t "*Whether to kill source files after sending the mail by default." "Kill source files after sending" 'boolean) (patcher-define-project-option kill-change-logs-after-sending t "*Whether to kill the ChangeLog files after sending the mail by default." "Kill ChangeLogs after sending" 'boolean) (patcher-define-project-option check-change-logs-insertion 'ask "*Whether to check for ChangeLogs insertion checking prior to sending. This option affects the behavior of Patcher when ChangeLogs are supposed to appear by manual insertion into the mail buffer. - If nil, Patcher never checks and lets you send the message as-is. - If t, Patcher blindly aborts the sending process if you have forgotten to insert the ChangeLogs in the message buffer. - If 'ask (the default), Patcher asks you whether you want to proceed with sending or not." "Check for ChangeLogs insertion before sending" '(radio (const :tag "Never check" nil) (const :tag "Abort sending upon omission" t) (const :tag "Ask the user" ask))) (patcher-define-project-option check-commit 'ask "*Whether to check for a commit prior to sending. This option affects the behavior of Patcher when you have set the :commit-privilege project option. - If nil, Patcher never checks and lets you send the message as-is. - If t, Patcher blindly aborts the sending process if you have forgotten to commit your changes. - If 'ask (the default), Patcher asks you whether you want to proceed with sending or not." "Check for commit before sending" '(radio (const :tag "Never check" nil) (const :tag "Abort sending upon omission" t) (const :tag "Ask the user" ask))) (patcher-define-project-option submodule-detection-function nil "*The name of a submodule automatic detection function, or nil." "Detect submodules" '(choice :value nil (const :tag "Detect Mercurial submodules" patcher-hg-detect-submodules) (symbol :tag "Other") (const :tag "Don't detect submodules" nil))) ;; #### NOTE: ideally, this type should be computed automatically, depending ;; on the defined themes. This arises the interesting question of custom ;; dynamic types. Without them, it's a complex thing to do. (patcher-define-project-option themes nil "*Default themes to use in Patcher projects. This is a list of theme names (symbols) that must be defined either in `patcher-themes' or `patcher-built-in-themes'." "Themes" '(repeat (symbol :tag "Theme name"))) ;; This used to be pushed at the end of +patcher-project-options-custom-type+, ;; but is currently useless, and would cause problems in the custom type: it ;; will match the inheritance field in patcher-projects before the ;; corresponding custom type definition. ;; (list :inline t :tag "Other" ;; symbol ;; sexp)) ;; Defining these constants avoids coding special cases for the :inheritance, ;; :subdirectory and :files (sub)project option in the accessor functions. (defconst patcher-default-inheritance nil) (defconst patcher-default-subdirectory nil) (defconst patcher-default-files nil) ;; =========================================================================== ;; Themes ;; =========================================================================== (defgroup patcher-themes nil "Patcher settings for themes." :group 'patcher) (defcustom patcher-themes () "*List of themes to use in Patcher projects. Each element looks like \(NAME :OPTION VALUE ...). NAME is the theme name (a symbol). The remainder of the list is the same as in project descriptors (see `patcher-projects'). Themes are searched for respectively in this variable and in `patcher-built-in-themes'. See also `patcher-max-theme-depth'." :group 'patcher-themes :type `(repeat (group (symbol :tag "Theme name") ;; #### NOTE: we could be tempted to add an `inheritance' ;; mechanism for themes, just like for projects. However, ;; don't forget that a theme can contain other themes because ;; themes belong to `+patcher-project-options-custom-type+'. (repeat :inline t :tag "Options" (choice :inline t :value (:mail-method compose-mail) ,@+patcher-project-options-custom-type+))))) (defconst patcher-built-in-themes nil "List of predefined themes. You can add new ones or override these ones in `patcher-themes'.") (defun patcher-themes () ;; Return the concatenation of user defined and built-in themes. (append patcher-themes patcher-built-in-themes)) (defun patcher-theme (name) ;; Return the theme named NAME. (assoc name (patcher-themes))) ;; Accessors ================================================================ (defvaralias 'patcher-max-theme-depth 'patcher-theme-max-depth) (defcustom patcher-theme-max-depth 8 "*Maximum nesting level in Patcher themes. This option is a guard against infinite loops that might occur for wrong settings of Patcher themes (as themes can contain themes)." :group 'patcher-themes :type 'integer) (defun patcher-theme-name (theme) ;; Return THEME's name (car theme)) (defun patcher-theme-options (theme) ;; Return THEME's option list. (cdr theme)) ;; #### NOTE: looking depth-first for options not directly available might not ;; be the best choice. (defun* patcher-themes-option (theme-names option level &aux theme-name theme value) ;; Look for OPTION in THEME-NAMES, no deeper than LEVEL. ;; Note that themes can have the :themes option set. Options are looked for ;; by depth first. (while (and (not value) (setq theme-name (pop theme-names))) (setq theme (patcher-theme theme-name)) (or theme (patcher-error "`%s': no such theme" theme-name)) (let ((theme-options (patcher-theme-options theme))) (setq value (member option theme-options)) (unless value (let ((subthemes (member :themes theme-options))) (when (> level patcher-theme-max-depth) (patcher-error "\ Theme `%s': maximum nesting level of themes exceeded. Either you have an infinite loop in your theme's :themes option, or you should increase the value of `patcher-max-theme-depth'" (patcher-theme-name theme))) (setq value (patcher-themes-option (cadr subthemes) option (1+ level))))))) value) ;; =========================================================================== ;; Projects, subprojects and submodules ;; =========================================================================== (defgroup patcher-projects nil "Patcher settings for projects." :group 'patcher) (defcustom patcher-projects () "*List of project descriptors. Each project descriptor looks like \(NAME DIR :OPTION VALUE ...). - NAME is the project's name \(a string). - DIR is the project's root directory (a string, or nil for prompting). The remainder of the project descriptor is composed of \"project options\" \(keyword / value pairs). When Patcher needs a project option, it tries to find it at different places: - First, it looks for it in the project descriptor itself. - If that fails, it tries to find it in the project themes, if any. - If that fails, it tries to find it in the inherited projects, if any. - If that fails, it falls back to the corresponding `patcher-default-*' user option." :group 'patcher-projects :type `(repeat (group (string :tag "Project") (choice :tag "Directory" :value nil (const :tag "Prompt" :value nil) (directory :tag "")) (repeat :inline t :tag "Options" (choice :inline t :value (:mail-method compose-mail) ,@+patcher-project-options-custom-type+ (list :inline t :tag "Inheritance" :format "%{%t%}: %v" (const :tag "" :value :inheritance) (repeat :tag "From" (string :tag "Project")))))))) ;; #### FIXME: this whole notion of subproject needs to be rethought. We ;; shouldn't need to keep subprojects separately. The :subdirectory and :files ;; options could be common options like the other ones, and :subdirectory ;; could then refer to either the first superproject in :inherit, or a ;; separate :superproject option. (defcustom patcher-subprojects () "*List of Patcher subproject descriptors. Subproject descriptors are similar to project descriptors \(see the variable `patcher-projects') with a few exceptions: - Instead of the project directory field DIR, you specify the name of the project this subproject is based on. - Two project options are available in addition to the standard ones: - :subdirectory lets you specify a subdirectory \(of the parent project's directory) in which the whole subproject resides. There is no corresponding `patcher-default-subdirectory' fallback.. - :files lets you specify a list of files or directories composing the subproject. Each file specification can contain wildcards. If a :subdirectory option is given, these files or directories should be relative to this subdirectory. Otherwise, they should be relative to the base project's directory. There is no corresponding `patcher-default-files' variable. Note that a subproject with neither a :subdirectory nor a :files option behaves exactly like the corresponding base project. - Subprojects don't have an :inheritance mechanism. Instead, they implicitly inherit from their base project \(which in turn can inherit from other projects). Note: the normal way to use predefined Patcher subprojects is to call `patcher-mail', *not* `patcher-mail-subproject'. Using the former will directly use the set of files and/or directory you have specified. Using the latter will also let you modify this set." :group 'patcher-projects :type `(repeat (group (string :tag "Subproject") (string :tag "Of project") (repeat :inline t :tag "Options" (choice :inline t :value (:subdirectory "") ;; #### Look inside the widget library to see ;; #### how we can modify the completion ;; #### behavior (list :inline t :tag "Subdirectory" :format "%{%t%}: %v" (const :tag "" :value :subdirectory) directory) (list :inline t :tag "Files" :format "%{%t%}: %v" (const :tag "" :value :files) (repeat :format "\n%v%i\n" file)) ,@+patcher-project-options-custom-type+))))) (defvar patcher-submodules nil ;; The list of automatically detected submodules ) ;; Accessors ================================================================ (defun patcher-subproject-p (descriptor) ;; Return non nil if DESCRIPTOR is defined in `patcher-subprojects'. (member descriptor patcher-subprojects)) (defun patcher-superproject-name (descriptor) ;; Return subproject DESCRIPTOR's super-project name. (assert (patcher-subproject-p descriptor)) (nth 1 descriptor)) (defun patcher-descriptor-name (descriptor) ;; Return DESCRIPTOR's name, which is different from its potential :name ;; option. This works for either project or subproject descriptors. (nth 0 descriptor)) (defun* patcher-descriptor-directory (descriptor &aux (directory (if (patcher-subproject-p descriptor) (let ((superproject (assoc (patcher-superproject-name descriptor) patcher-projects))) (unless superproject (patcher-error "Can't find base project for subproject `%s'" (patcher-descriptor-name descriptor))) (nth 1 superproject)) (nth 1 descriptor)))) ;; Return the directory of DESCRIPTOR as a file name. ;; If DESCRIPTOR describes a subproject, return the superproject's ;; directory. (when directory (directory-file-name directory))) (defun patcher-descriptor-options (descriptor) ;; Return DESCRIPTOR's options list. (cddr descriptor)) ;; #### NOTE: Project options accessors don't handle the case where the same ;; option is given several times. Only the first one is used, which is the ;; only sensible thing to do anyway. (defcustom patcher-max-inheritance-depth 8 "*Maximum nesting level in Patcher projects. This option is a guard against infinite loops that might occur for wrong settings of Patcher projects (as projects can inherit projects)." :group 'patcher-projects :type 'integer) (defun* patcher-descriptor-option (descriptor option level &aux (name (patcher-descriptor-name descriptor)) (subprojectp (patcher-subproject-p descriptor))) ;; Look for OPTION in DESCRIPTOR, at current nesting LEVEL. ;; If not found, try to find it in a theme or in the (sub)project's ;; inheritance tree. ;; Return the whole option form: '(:option value) ;; #### NOTE: the :inheritance option is illegal in subprojects and it is ;; just ignored. Conversely, the :subdirectory and :files options are ;; illegal in regular projects, and they are also ignored. This function ;; just returns nil in such cases, which makes sense for blind calls which ;; don't know if they are working on regular or subprojects. (unless (and (member option '(:subdirectory :files)) (not subprojectp)) (when (> level patcher-max-inheritance-depth) (patcher-error "\ Project `%s': maximum nesting level of projects exceeded. Either you have an infinite loop in your project's inheritance, or you should increase the value of `patcher-max-inheritance-depth'" name)) (let* ((options (patcher-descriptor-options descriptor)) (value (member option options))) (unless value ;; Try to find the option in a theme. (let ((themes (member :themes options))) (when themes (setq value (patcher-themes-option (cadr themes) option 0))))) (unless value ;; Try to find the option in inherited projects. Note that inherited ;; projects can have their :inherit option set in turn. (let ((project-names (if subprojectp (list (patcher-superproject-name descriptor)) (cadr (member :inheritance options)))) project-name) (when project-names (while (and (not value) (setq project-name (pop project-names))) (setq value (patcher-descriptor-option (assoc project-name patcher-projects) option (1+ level))))))) value))) ;; Prompting ================================================================ (defun patcher-detect-submodules () "Scan PATCHER-PROJECTS and detect potential submodules automatically." (interactive) (setq patcher-submodules nil) (dolist (descriptor patcher-projects) (when (nth 1 descriptor) (let ((detection-function (or (cadr (patcher-descriptor-option descriptor :submodule-detection-function 0)) patcher-default-submodule-detection-function))) (when detection-function (let ((submodules (funcall detection-function (nth 1 descriptor)))) (dolist (submodule submodules) (push (list (format "%s (%s)" (car descriptor) (car submodule)) (expand-file-name (cadr submodule) (nth 1 descriptor)) :inheritance (list (car descriptor))) patcher-submodules)))))))) (defun patcher-project-descriptors () ;; Return the list of submodule, subproject and project descriptors. (let ((user-projects (append patcher-subprojects patcher-projects))) (unless patcher-submodules (patcher-detect-submodules)) (if (eq patcher-submodules t) user-projects (append user-projects patcher-submodules)))) (defun patcher-project-descriptor (name) ;; Return the project descriptor for NAME. (assoc name (patcher-project-descriptors))) (defvar patcher-project-name-history nil) (defun* patcher-prompt-name (&aux (descriptors (patcher-project-descriptors)) name) ;; Prompt for, and return a project name. ;; Prompting is done with completion and requires a match. (while (zerop (length (setq name (completing-read "Project: " descriptors nil t nil 'patcher-project-name-history)))) (beep)) name) (provide 'patcher-project) ;;; patcher-project.el ends here