;;; patcher-source.el --- Sources utilities

;; Copyright (C) 2010 Didier Verna

;; Author:        Didier Verna <didier@lrde.epita.fr>
;; Maintainer:    Didier Verna <didier@lrde.epita.fr>
;; Created:       Tue May 11 14:05:35 2010
;; Last Revision: Sun May 30 18:30:47 2010
;; Keywords:      maint


;; This file is part of Patcher.

;; Patcher is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License version 3,
;; as published by the Free Software Foundation.

;; Patcher is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.


;;; Commentary:

;; Contents management by FCM version 0.1.


;;; Code:

(require 'cl)

(eval-when-compile (require 'patcher-cutil))
(require 'patcher-util)
(require 'patcher-project)
(require 'patcher-instance)



;; ==========================================================================
;; Utilities
;; ==========================================================================

(patcher-define-error 'source
  "Patcher source error.")

(put 'patcher-mapcar-source-extents 'lisp-indent-function 1)
(defmacro* patcher-mapcar-source-extents ((var &optional buffer) &body body)
  ;; Map BODY over all extents marking a source contents in BUFFER.
  `(patcher-mapcar-extents (,var 'source :here ,buffer)
    ,@body))

(defun patcher-sources (&optional buffer)
  ;; Return the list of source absolute file names appearing in BUFFER.
  (patcher-collect-extents-property 'source buffer))

(defun patcher-source-extents (&optional buffer)
  ;; Return the list of source extents in BUFFER.
  (patcher-extents 'source :here buffer))

(patcher-define-error 'sources-consistency
  "Patcher sources consistency error."
  'source)

(defun patcher-source-contents (&optional buffer)
  ;; Return the string containing all source contents in BUFFER.
  (apply #'concat
    (patcher-mapcar-source-extents (extent buffer)
      (extent-string extent))))

(defun patcher-detect-inconsistent-sources (project)
  ;; Detect inconsistent sources in PROJECT's process buffer diff.
  ;; Inconsistent means either spurious or missing diff.
  ;; Throw a sources-consistency error when detected.
  (multiple-value-bind (result spurious missing)
      (patcher-list=
	  (patcher-sources (patcher-project-process-buffer project))
	  (patcher-project-sources project)
	:test #'string=)
    (unless result
      (patcher-error 'sources-consistency
		     (when spurious (patcher-files-string spurious))
		     (when missing (patcher-files-string missing))))))

(defun patcher-inconsistent-sources-description (spurious missing)
  ;; Return a string describing SPURIOUS and/or MISSING sources.
  (concat "Sources inconsistency detected."
	  (when spurious
	    (format "\nSpurious source diffs: %s" spurious "."))
	  (when missing
	    (format "\nMissing  source diffs: %s" missing "."))))




;; ==========================================================================
;; Source referencing
;; ==========================================================================

;; Source buffers ========================================================

(put 'patcher-reference-source 'lisp-indent-function 1)
(defun patcher-reference-source (project source existing)
  ;; Add a reference to PROJECT in SOURCE buffer.
  ;; EXISTING means that the buffer was not loaded by Patcher, so it should be
  ;; protected with an initial t value in patcher-references.
  (when source
    (with-current-buffer source
      (when (and existing (null patcher-references))
	(push t patcher-references)))
;;;    (patcher-source-minor-mode t))
    (patcher-reference-buffer project source)))

(put 'patcher-unreference-source 'lisp-indent-function 1)
(defun patcher-unreference-source (project source kill)
  ;; Remove the reference to PROJECT from SOURCE buffer.
  ;; If KILL and PROJECT was the last reference in the SOURCE buffer,
  ;; authorize Patcher to kill the SOURCE buffer.
;;;  ;; This function also removes the source minor mode from the SOURCE buffer
;;;  ;; when necessary.
  (when source
    (with-current-buffer source
      (multiple-value-bind (lastp)
	  (patcher-unreference-buffer project source kill)
	(when lastp
;;;      (patcher-source-minor-mode -1)
	  )))))

(put 'patcher-source-buffers 'lisp-indent-function 1)
(defun* patcher-source-buffers (project &optional find &aux buffers)
  ;; Return a list of buffers visiting PROJECT's source files.
  ;; If FIND, make sure to visit all source files. Otherwise, skip
  ;; unvisited ones.
  ;; This function also references PROJECT in each source buffer.
  (dolist (file (patcher-project-sources project) buffers)
    (multiple-value-bind (buffer existing)
	(patcher-file-buffer file find)
      (when buffer
	(patcher-reference-source project buffer existing)
	(patcher-endpush buffer buffers)))))

(defun patcher-save-sources (project)
  ;; Save PROJECT's source buffers.
  (patcher-save-buffers (patcher-source-buffers project)))


;; Source files =============================================================

(put 'patcher-link-source 'lisp-indent-function 1)
(defun patcher-link-source (project source)
  ;; Link SOURCE to PROJECT.
  ;; This function handles buffer reference if SOURCE is already loaded,
  ;; but doesn't load it otherwise.
  (unless (member source (patcher-project-sources project))
    (patcher-endpush source (patcher-project-sources project))
    (patcher-reference-source project (get-file-buffer source) 'existing)))

(defun patcher-link-sources (project sources)
  ;; Link SOURCES to PROJECT.
  (dolist (source sources)
    (patcher-link-source project source)))

(defun* patcher-unlink-source
    (project source override-kill
     &aux (kill (or override-kill
		    (patcher-project-option project
		      :kill-sources-after-sending))))
  ;; Unlink SOURCE from PROJECT.
  ;; If OVERRIDE-KILL, override the :kill-sources-after-sending option.
  (when (member source (patcher-project-sources project))
    (patcher-unreference-source project (get-file-buffer source) kill)
    (setf (patcher-project-sources project)
	  (delete source (patcher-project-sources project)))))

(put 'patcher-unlink-sources 'lisp-indent-function 1)
(defun* patcher-unlink-sources
    (project
     &key (sources (patcher-project-sources project))
	  override-kill
     &aux (kill (or override-kill
		    (patcher-project-option project
		      :kill-sources-after-sending))))
  ;; Unlink SOURCES from PROJECT.
  ;; If OVERRIDE-KILL, override the :kill-sources-after-sending option.
  (dolist (source sources)
    (patcher-unlink-source project source kill)))


(provide 'patcher-source)

;;; patcher-source.el ends here