(lisp-set-implementation "Interleaf Lisp" "2.0")
;; Module name: AddTITLE.lsp
;; Purpose:     Scan documents for TITLE attribute in preparation for
;;              WorldView Press operations. All selected icons and all
;;              icons in selected containers are shown, but the TITLE
;;              attribute is only checked/set for "document" and
;;              "host file" class icons.
;; Notes:
;;    *** THIS LISP IS NOT SUPPORTED - USE AT YOUR OWN RISK ***
;;    Place in Selection cabinet
;; Interfaces:

;; Audit:
;; DD-MON-YY USERNAME	COMMENT
;; 03-MAR-94 D.W.Eaton  Initial release
;; 13-APR-94 D.W.Eaton  TITLE entry of -exit- terminates
;;
;; Copyright 1994 D.W.Eaton - dwe@arde.com
;; This script may be freely distributed providing these statements
;; remain intact and the script is distributed in its entirety.

(defun show-addtitle-help ()
 (stayup "AddTITLE - Version 1.1

Function

This will scan documents and host files for the TITLE attribute in
preparation for WorldView Press operations. All selected icons and all
icons in selected containers are shown, but the TITLE attribute is
only checked/set for document class icons and host-file class icons
(since these may be postscript files, etc.) Icons which are sub-classes
of these icon types are processed as well.

Stayup

A running list of icon names encountered is shown in a stayup window
as the tool executes. Container names are followed by the '>' character.
Each subsequent container level is indented from the previous level.
Icons which are neither containers nor documents nor host files are
followed by a '.' character. If a document or host file icon does have
a TITLE attribute, the current TITLE is shown as well. For each document
or host file which does not have a TITLE attribute, the user is requested
to enter a title. Choosing the Cancel option skips the current icon
without assigning a TITLE and the next icon located is processed. At the
end of the report, a count of the documents and host files still needing
a TITLE is shown.

The stayup may be printed or saved for later review (which would allow
other operations, such as spelling checks of the TITLEs assigned.)
A sample of the stayup follows:

 Selected and child documents and host files in desktop with TITLEs are:

  Test >
   doc1: TITLE = This is document 1
   foldr >
    fdoc2: TITLE =
    fdoc3: TITLE = This is document 3
    alispicon.
    ASCII-file1: TITLE = This is ASCII file 1
   ASCII-file2: TITLE =
   sub-class: TITLE = This is a document sub-class icon

 Total of 2 icon(s) still need TITLEs.
 Done.

Limitations

In this version, only document and host file icons are processed.
Other icon classes will not have TITLEs added to them.

Revision History

1.0  03 MAR 94 dwe
	First released version.
1.1  13 APR 94 dwe
	TITLE entry of -exit- terminats

Corrections

If you make any corrections or extensions to this package, please forward them to:
Artronic Development; 4848 E. Cactus Rd. Suite 505-224; Scottsdale, Arizona 85254 - Attn: Dave Eaton
or e-mail to: dwe@arde.com

** This application is unsupported - use at your own risk. **

(This is not a product of Artronic Development or Interleaf, Inc.)"
 :title "AddTITLE Help Information"))

(defun doc-special-action (next1 doc_tot)
 ;; (returns incremented doc_tot if no TITLE applied)
 (let ((attrs (tell next1 mid:get-props :attributes))
    this_doc_title)
    (setq this_doc_title "none")
    (while attrs
      (if (equal (car (car attrs)) "TITLE")
        ;; Found it - save this TITLE and quit search
        (progn
          (setq this_doc_title (cdr (car attrs)))
          (setq attrs nil))
        ;; Try next attribute
        (setq attrs (cdr attrs))))
    ;;
    (if (equal this_doc_title nil)
      (setq this_doc_title "none"))
    (if (equal this_doc_title "none")
      (progn
        ;; Show user where we are in case that helps them:
        (stayup:add-string ":" mstay :refresh t)
        ;; Ask the user for a TITLE (if user 'cancels', don't assign this one):
        (setq this_doc_title (stk-open
          "Enter TITLE for" (tell next1 mid:get-name)
             (tell (tell next1 mid:get-class) mid:get-name)
             "or choose Cancel to skip this object, or enter -exit- to abort this process"
             :input 60))
        (if this_doc_title
          (if (equal this_doc_title "-exit-")
             ;; exit if user so requested:
             (progn
               (stayup:add-line "" mstay)
               (stayup:add-line "ABORT: USER REQUESTED EXIT" mstay)
               (toplevel))
             ;; Set new TITLE on document:
             (tell next1 mid:set-props :attributes
               (append (list (list "TITLE" this_doc_title)) nil)))
          ;; otherwise, bump count if no TITLE supplied
          (setq doc_tot (+ doc_tot 1))))
      ;; No need to display right now if a title was present
      (stayup:add-string ":" mstay))
    ;; Finish document line
    (stayup:add-string " TITLE = " mstay)
    (stayup:add-line this_doc_title mstay)
    (setq doc_tot doc_tot) ;; be sure to return current total value
))

(defun find-all-docs (mstay pass-arg &optional (container (dt-pointer-container)) (selopt ":selected") (level 1))
 ;; (returns updated value of 'pass-arg')
 (let* (children-docs num)

 (if (equal selopt ":selected")
  (setq children-docs (dt-children container :selected))
  (if (equal selopt ":all")
   (setq children-docs (dt-children container :all))
   (if (equal selopt ":not-selected")
    (setq children-docs (dt-children container :not-selected))
    (progn (stayup:add-line (format nil "Bad selector: ~a, assuming ':all'" selopt) mstay)
     (setq children-docs (dt-children container :all))))))

 (while
  (setq next1 (pop children-docs))
  (if (not (equal next1 nil))
   (progn
    (for ((setq num 0) (< num level) (inc num))
     (stayup:add-string (format nil "~T") mstay))
    (stayup:add-string (tell next1 mid:get-name) mstay)
    (if (is-of-class next1 dt-container-class)
      ;; Container:
      (progn
       (stayup:add-line " > " mstay)
       ;; show all icons in selected containers (for selected, use :selected)
       (setq pass-arg (find-all-docs mstay pass-arg next1 ":all" (+ level 1))))
      ;; or
      (if (or (is-of-class next1 dt-document-class)
              (is-of-class next1 dt-host-file-class))
       ;; Document or hostfile (may be postscript):
       (setq pass-arg (doc-special-action next1 pass-arg))
       ;; Other Icon:
       (stayup:add-line "." mstay))
   ))
  ) ; endif
 ) ; end while
 (setq pass-arg pass-arg)
))

;; --- AddTITLE Main Routine Starts Here ---
(let (mystay start doc_tot do-what)
 (setq doc_tot 0)
 (setq start (dt-set-container (dt-pointer-container)))
 ;; Find out what user wants to do:
 (setq do-what (stk-open
"AddTITLE

This command will add a TITLE attribute to documents and host files.

What do you want to do?" :buttons
  (list "See More Help" "Add TITLEs" "Cancel")))

 (if (eql 2 do-what)
  ;; cancel and exit this application
  (toplevel))

 (if (eql 0 do-what)
  ;; user wants help, then exit
  (progn
   (show-addtitle-help)
   (toplevel)))

 (if (eql 1 do-what)
  (progn
   ;; Do the work
   ;; Start to build the results stay-up
   (setq mystay (stayup "Selected and child documents and host files in " :title "Icon TITLE Attribute Status"))
   (stayup:add-string (tell start mid:get-name) mystay)
   (stayup:add-line " with TITLEs are:" mystay :refresh t)
   (stayup:add-line "" mystay)
   ;; go find and process all documents
   (setq doc_tot (find-all-docs mystay doc_tot start ":selected" 1))
   ;; wrap-up the stayup
   (stayup:add-line "" mystay)
   (stayup:add-line (format nil "Total of ~D icon(s) still need TITLEs." doc_tot) mystay)
   (stayup:add-line "Done." mystay)
 )))
;; End of AddTITLE