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

   1 ;;; patcher-source.el --- Sources utilities
   2
   3 ;; Copyright (C) 2010 Didier Verna
   4
   5 ;; Author:        Didier Verna <didier@lrde.epita.fr>
   6 ;; Maintainer:    Didier Verna <didier@lrde.epita.fr>
   7 ;; Created:       Tue May 11 14:05:35 2010
   8 ;; Last Revision: Sun May 30 18:30:47 2010
   9 ;; Keywords:      maint
  10
  11
  12 ;; This file is part of Patcher.
  13
  14 ;; Patcher is free software; you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License version 3,
  16 ;; as published by the Free Software Foundation.
  17
  18 ;; Patcher is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with this program; if not, write to the Free Software
  25 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  26
  27
  28 ;;; Commentary:
  29
  30 ;; Contents management by FCM version 0.1.
  31
  32
  33 ;;; Code:
  34
  35 (require 'cl)
  36
  37 (eval-when-compile (require 'patcher-cutil))
  38 (require 'patcher-util)
  39 (require 'patcher-project)
  40 (require 'patcher-instance)
  41
  42
  43 \f
  44 ;; ==========================================================================
  45 ;; Utilities
  46 ;; ==========================================================================
  47
  48 (patcher-define-error 'source
  49   "Patcher source error.")
  50
  51 (put 'patcher-mapcar-source-extents 'lisp-indent-function 1)
  52 (defmacro* patcher-mapcar-source-extents ((var &optional buffer) &body body)
  53   ;; Map BODY over all extents marking a source contents in BUFFER.
  54   `(patcher-mapcar-extents (,var 'source :here ,buffer)
  55     ,@body))
  56
  57 (defun patcher-sources (&optional buffer)
  58   ;; Return the list of source absolute file names appearing in BUFFER.
  59   (patcher-collect-extents-property 'source buffer))
  60
  61 (defun patcher-source-extents (&optional buffer)
  62   ;; Return the list of source extents in BUFFER.
  63   (patcher-extents 'source :here buffer))
  64
  65 (patcher-define-error 'sources-consistency
  66   "Patcher sources consistency error."
  67   'source)
  68
  69 (defun patcher-source-contents (&optional buffer)
  70   ;; Return the string containing all source contents in BUFFER.
  71   (apply #'concat
  72     (patcher-mapcar-source-extents (extent buffer)
  73       (extent-string extent))))
  74
  75 (defun patcher-detect-inconsistent-sources (project)
  76   ;; Detect inconsistent sources in PROJECT's process buffer diff.
  77   ;; Inconsistent means either spurious or missing diff.
  78   ;; Throw a sources-consistency error when detected.
  79   (multiple-value-bind (result spurious missing)
  80       (patcher-list=
  81           (patcher-sources (patcher-project-process-buffer project))
  82           (patcher-project-sources project)
  83         :test #'string=)
  84     (unless result
  85       (patcher-error 'sources-consistency
  86                      (when spurious (patcher-files-string spurious))
  87                      (when missing (patcher-files-string missing))))))
  88
  89 (defun patcher-inconsistent-sources-description (spurious missing)
  90   ;; Return a string describing SPURIOUS and/or MISSING sources.
  91   (concat "Sources inconsistency detected."
  92           (when spurious
  93             (format "\nSpurious source diffs: %s" spurious "."))
  94           (when missing
  95             (format "\nMissing  source diffs: %s" missing "."))))
  96
  97
  98
  99 \f
 100 ;; ==========================================================================
 101 ;; Source referencing
 102 ;; ==========================================================================
 103
 104 ;; Source buffers ========================================================
 105
 106 (put 'patcher-reference-source 'lisp-indent-function 1)
 107 (defun patcher-reference-source (project source existing)
 108   ;; Add a reference to PROJECT in SOURCE buffer.
 109   ;; EXISTING means that the buffer was not loaded by Patcher, so it should be
 110   ;; protected with an initial t value in patcher-references.
 111   (when source
 112     (with-current-buffer source
 113       (when (and existing (null patcher-references))
 114         (push t patcher-references)))
 115 ;;;    (patcher-source-minor-mode t))
 116     (patcher-reference-buffer project source)))
 117
 118 (put 'patcher-unreference-source 'lisp-indent-function 1)
 119 (defun patcher-unreference-source (project source kill)
 120   ;; Remove the reference to PROJECT from SOURCE buffer.
 121   ;; If KILL and PROJECT was the last reference in the SOURCE buffer,
 122   ;; authorize Patcher to kill the SOURCE buffer.
 123 ;;;  ;; This function also removes the source minor mode from the SOURCE buffer
 124 ;;;  ;; when necessary.
 125   (when source
 126     (with-current-buffer source
 127       (multiple-value-bind (lastp)
 128           (patcher-unreference-buffer project source kill)
 129         (when lastp
 130 ;;;      (patcher-source-minor-mode -1)
 131           )))))
 132
 133 (put 'patcher-source-buffers 'lisp-indent-function 1)
 134 (defun* patcher-source-buffers (project &optional find &aux buffers)
 135   ;; Return a list of buffers visiting PROJECT's source files.
 136   ;; If FIND, make sure to visit all source files. Otherwise, skip
 137   ;; unvisited ones.
 138   ;; This function also references PROJECT in each source buffer.
 139   (dolist (file (patcher-project-sources project) buffers)
 140     (multiple-value-bind (buffer existing)
 141         (patcher-file-buffer file find)
 142       (when buffer
 143         (patcher-reference-source project buffer existing)
 144         (patcher-endpush buffer buffers)))))
 145
 146 (defun patcher-save-sources (project)
 147   ;; Save PROJECT's source buffers.
 148   (patcher-save-buffers (patcher-source-buffers project)))
 149
 150
 151 ;; Source files =============================================================
 152
 153 (put 'patcher-link-source 'lisp-indent-function 1)
 154 (defun patcher-link-source (project source)
 155   ;; Link SOURCE to PROJECT.
 156   ;; This function handles buffer reference if SOURCE is already loaded,
 157   ;; but doesn't load it otherwise.
 158   (unless (member source (patcher-project-sources project))
 159     (patcher-endpush source (patcher-project-sources project))
 160     (patcher-reference-source project (get-file-buffer source) 'existing)))
 161
 162 (defun patcher-link-sources (project sources)
 163   ;; Link SOURCES to PROJECT.
 164   (dolist (source sources)
 165     (patcher-link-source project source)))
 166
 167 (defun* patcher-unlink-source
 168     (project source override-kill
 169      &aux (kill (or override-kill
 170                     (patcher-project-option project
 171                       :kill-sources-after-sending))))
 172   ;; Unlink SOURCE from PROJECT.
 173   ;; If OVERRIDE-KILL, override the :kill-sources-after-sending option.
 174   (when (member source (patcher-project-sources project))
 175     (patcher-unreference-source project (get-file-buffer source) kill)
 176     (setf (patcher-project-sources project)
 177           (delete source (patcher-project-sources project)))))
 178
 179 (put 'patcher-unlink-sources 'lisp-indent-function 1)
 180 (defun* patcher-unlink-sources
 181     (project
 182      &key (sources (patcher-project-sources project))
 183           override-kill
 184      &aux (kill (or override-kill
 185                     (patcher-project-option project
 186                       :kill-sources-after-sending))))
 187   ;; Unlink SOURCES from PROJECT.
 188   ;; If OVERRIDE-KILL, override the :kill-sources-after-sending option.
 189   (dolist (source sources)
 190     (patcher-unlink-source project source kill)))
 191
 192
 193 (provide 'patcher-source)
 194
 195 ;;; patcher-source.el ends here