---------------------------------------------------------
-- changelog-oper

[: type entityfile]
[: latest-written "2010-12-08/14:42.+01"]
[: contents <changelog-oper add-to-log logfil-for time-point lognote: lognote>]
[: changed-since-archived t]
[: latest-archived-entity ap-0012]
[: latest-rearchived ap-0012]
[: nullvalued {has-purpose has-author requires mustload leos-extension has-profile overlay-on overlay-types overlay-own leos-use dont-display sections local-ents purpose author}]

@Comment
The function add-to-log is invoked from the ef leoprint, in such a way that if it is
writing an entityfile and an entity has a property called @Log (i.e. following a line
containing @@Log) and if furthermore the present ef has been loaded, then that property
is accumulated to a file containing a log of changes, and the property is set to nil so
that it does not appear in the ef being written. On the other hand if the present ef has
not been loaded then the property is written as usual.
   
In this way the user can put comments concerning changes in the @Log property and they will
be collected to the log of changes at convenient times.
 
---------------------------------------------------------
-- add-to-log

[: type lispdef]
[: latest-rearchived ap-0012]

(defun add-to-log (ef ent) 
    (let* ((id (funcall (get 'lognote\: 'symbfun) (date-intl)(time-point) ef ent))
           (logfil (logfil-for ef)) )
          (setf (get id 'Log)(get ent '@Log))
          (setf (get id 'textprops) (list 'set& (list 'Log)))
          (nconc (cadr (get logfil 'contents))
                 (list id) )
          (write-ef logfil)
          (ok-record) ))
  
 
---------------------------------------------------------
-- logfil-for

[: type lispdef]
[: latest-rearchived ap-0012]

(defun logfil-for (ef)
    (let* ((eflog (intern (concatenate 'string (string ef) "-log"))))
          (if (get eflog 'in-directory)
              eflog
              (let* ((efloc (funcall (get 'location\: 'symbfun) ef))
                     (efdir (get efloc 'in-directory))
                     (logdir (concatenate 'string efdir "log/"))
                     (logfil (concatenate 'string logdir (string eflog))) )
                    (setf (get eflog 'type) 'entityfile)
                    (setf (get eflog 'in-directory) logdir)
                    (setf (get eflog 'has-filename) (string eflog))
                    (setf (get eflog 'filename)
                          (concatenate 'string logdir (string eflog)) )
                    (cond ((open (concatenate 'string logfil ".leo") :direction :probe)
                           (load-ef eflog) )
                          (t (setf (get eflog 'contents)(list 'seq& (list eflog)))
                             (mkdir logdir)
                             (mkdir (concatenate 'string logdir "cl/"))
                             (write-ef eflog) ))
                    eflog ))))
 
---------------------------------------------------------
-- time-point

[: type lispdef]
[: latest-rearchived ap-0012]

(defun time-point ()
       (multiple-value-bind (s m h d mo y dw dlf tz)
          (get-decoded-time)
          (concatenate 'string (twoplace h)
             "." (twoplace m) "." (twoplace s) ) )) 
 
---------------------------------------------------------
-- lognote:

[: type Ecomposer]
[: latest-rearchived ap-0012]
[: nullvalued {argtypes valtype}]

(leodef (lognote\: symbfun) (date time ef ent)
        (let* ((sx (list 'lognote\: date time ef ent))
               (id (intern (prin1-to-string sx))) )
              (setf (get id 'type) 'lognote)
              (setf (get id 'symbexpr) sx)
              id ))
 
---------------------------------------------------------
-- lognote

[: type thingtype]
[: attributes <>]
[: latest-rearchived ap-0012]
[: nullvalued {description subsumed-by has-attributes has-categories create-proc registr-proc}]

ooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
