comparison lisp/hyperbole/kotl/kimport.el @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children c53a95d3c46d
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;!emacs
2 ;;
3 ;; FILE: kimport.el
4 ;; SUMMARY: Convert and insert other outline file formats into koutlines.
5 ;; USAGE: GNU Emacs V19 Lisp Library
6 ;; KEYWORDS: data, outlines, wp
7 ;;
8 ;; AUTHOR: Bob Weiner & Kellie Clark
9 ;;
10 ;; ORIG-DATE: 15-Nov-93 at 11:57:05
11 ;; LAST-MOD: 1-Nov-95 at 23:19:09 by Bob Weiner
12 ;;; ************************************************************************
13 ;;; Other required Elisp libraries
14 ;;; ************************************************************************
15
16 ;; kfile.el requires kotl-mode.el which requires kimport.el.
17 (require 'wrolo)
18
19 ;;; ************************************************************************
20 ;;; Public variables
21 ;;; ************************************************************************
22
23 ;; kimport:mode-alist and kimport:suffix-alist are defined in
24 ;; "../hyperbole.el".
25
26 ;;; ************************************************************************
27 ;;; Public functions
28 ;;; ************************************************************************
29
30 ;;;###autoload
31 (defun kimport:file (import-from output-to &optional children-p)
32 "Import a buffer or file IMPORT-FROM into the koutline in buffer or file OUTPUT-TO.
33
34 Any suffix in IMPORT-FROM's buffer name is used to determine the type of
35 importation. All others are imported as text, one paragraph per cell.
36
37 See the documentation for the variable, `kimport:suffix-alist' for
38 information on specific importation formats."
39 (interactive "FImport from buffer/file: \nFInsert into koutline buffer/file: \nP")
40 (let ((import-buf-name
41 (cond ((or (bufferp import-from)
42 (get-buffer import-from))
43 (buffer-name (get-buffer import-from)))
44 ((get-file-buffer import-from)
45 (buffer-name (get-file-buffer import-from)))
46 ((stringp import-from)
47 (file-name-nondirectory import-from))
48 (t (error "(kimport:buffer): `%s' is an invalid `import-from' argument"))))
49 (function))
50
51 (set-buffer import-buf-name)
52 (if (setq function (cdr (assq major-mode kimport:mode-alist)))
53 nil
54 (let ((import-suffix (if (string-match "\\..+\\'" import-buf-name)
55 (match-string 0 import-buf-name)))
56 (suffix-alist kimport:suffix-alist)
57 suffix-regexp)
58 (while (and import-suffix suffix-alist)
59 (setq suffix-regexp (car (car suffix-alist))
60 function (cdr (car suffix-alist))
61 suffix-alist (cdr suffix-alist))
62 (if (string-match suffix-regexp import-suffix)
63 nil
64 (setq function nil)))
65 (if function nil (setq function (cdr (assq t kimport:mode-alist))))))
66 (funcall function import-from output-to children-p)))
67
68 ;;; Augment right-side numbered files, blank line between cells
69 ;;;
70
71 ;;;###autoload
72 (defun kimport:aug-post-outline (import-from output-to &optional children-p)
73 "Insert Augment outline statements from IMPORT-FROM into koutline OUTPUT-TO.
74 Displays and leaves point in OUTPUT-TO. See documentation for
75 `kimport:initialize' for valid values of IMPORT-FROM and OUTPUT-TO and for
76 an explanation of where imported cells are placed.
77
78 If OUTPUT-TO is a new koutline, the first statement inserted will be the
79 first cell. Otherwise, it will be the successor of the current cell.
80
81 Each statement to be imported is delimited by an Augment relative id at the
82 end of the statement. \"1\" = level 1, \"1a\" = level 2 in outline and so
83 on."
84 (interactive "FImport from Augment post-numbered buffer/file: \nFBuffer/file to insert cells into: \nP")
85 (let ((output-level 1) (klabel "1")
86 initially-empty-output no-renumber orig-point count total)
87 ;; Don't change the order of import-from and output-to inits here.
88 (setq import-from (kimport:copy-and-set-buffer import-from)
89 output-to (kimport:initialize output-to)
90 orig-point (point)
91 initially-empty-output (zerop (- (point-max) (point-min)))
92 no-renumber (or initially-empty-output
93 (not (if children-p
94 (kcell-view:child-p)
95 (kcell-view:sibling-p)))))
96
97 (if (eq import-from output-to)
98 (error "(kimport:aug-post-outline): Import and output buffers may not be the same."))
99
100 (set-buffer import-from)
101 (show-all)
102 (save-excursion
103 (goto-char (point-min))
104 ;; Total number of Augement statements.
105 (setq total (read (count-matches
106 " +\\([0-9][0-9a-z]*\\)\n\\(\n\\|\\'\\)")))
107 (if initially-empty-output
108 nil
109 ;; Insert first cell as sibling of current cell.
110 (set-buffer output-to)
111 (if children-p
112 ;; Insert as children.
113 (progn (setq klabel (klabel:child (kcell-view:label))
114 output-level (klabel:level klabel))
115 ;; Move to end of this cell since cell insertion will
116 ;; occur at point.
117 (goto-char (kcell-view:end)))
118 ;; Insert as successors.
119 (setq klabel (klabel:increment (kcell-view:label))
120 output-level (klabel:level klabel))
121 ;; Move to start of line of next tree since cell insertion will occur
122 ;; at point.
123 (goto-char (kotl-mode:tree-end))))
124 (setq count (kimport:aug-post-statements
125 import-from output-to klabel output-level 1 0 total)))
126 (pop-to-buffer output-to)
127 (kfile:narrow-to-kcells)
128 (if no-renumber nil (klabel-type:update-labels klabel))
129 (goto-char orig-point)
130 (if (kotl-mode:buffer-empty-p)
131 nil
132 (kotl-mode:to-valid-position))
133 (message "Imported %d of %d Augment statements." count total)))
134
135 ;;;
136 ;;; Emacs outliner style files, leading '*' cell delimiters
137 ;;;
138
139 ;;;###autoload
140 (defun kimport:star-outline (import-from output-to &optional children-p)
141 "Insert star outline nodes from IMPORT-FROM into koutline OUTPUT-TO.
142 Displays and leaves point in OUTPUT-TO. See documentation for
143 `kimport:initialize' for valid values of IMPORT-FROM and OUTPUT-TO and for
144 an explanation of where imported cells are placed.
145
146 \"* \" = level 1, \"** \" = level 2 in outline and so on."
147 (interactive "FImport from star delimited cells buffer/file: \nFBuffer/file to insert cells into: \nP")
148 (let ((output-level 1) (klabel "1")
149 initially-empty-output no-renumber orig-point count total)
150 ;; Don't change the order of import-from and output-to inits here.
151 (setq import-from (kimport:copy-and-set-buffer import-from)
152 output-to (kimport:initialize output-to)
153 orig-point (point)
154 initially-empty-output (zerop (- (point-max) (point-min)))
155 no-renumber (or initially-empty-output
156 (not (if children-p
157 (kcell-view:child-p)
158 (kcell-view:sibling-p)))))
159
160 (if (eq import-from output-to)
161 (error "(kimport:star-outline): Import and output buffers may not be the same."))
162
163 (set-buffer import-from)
164 (show-all)
165 (save-excursion
166 (goto-char (point-min))
167 ;; If initial text in buffer is not an star outline node, add a star to
168 ;; make it one, so it is not deleted from the import.
169 (if (not (looking-at "[ \t]*\\*"))
170 (insert "* "))
171 (goto-char (point-min))
172 ;; Total number of top-level cells.
173 (setq total (read (count-matches "^[ \t]*\\*[ \t\n]")))
174 (if initially-empty-output
175 nil
176 ;; Insert first cell as sibling of current cell.
177 (set-buffer output-to)
178 (if children-p
179 ;; Insert as children.
180 (progn (setq klabel (klabel:child (kcell-view:label))
181 output-level (klabel:level klabel))
182 ;; Move to end of this cell since cell insertion will
183 ;; occur at point.
184 (goto-char (kcell-view:end)))
185 ;; Insert as successors.
186 (setq klabel (klabel:increment (kcell-view:label))
187 output-level (klabel:level klabel))
188 ;; Move to start of line of next tree since cell insertion will occur
189 ;; at point.
190 (goto-char (kotl-mode:tree-end))))
191 (setq count (kimport:star-entries
192 import-from output-to klabel output-level 1 0 total)))
193 (pop-to-buffer output-to)
194 (kfile:narrow-to-kcells)
195 (if no-renumber nil (klabel-type:update-labels klabel))
196 (goto-char orig-point)
197 (if (kotl-mode:buffer-empty-p)
198 nil
199 (kotl-mode:to-valid-position))
200 (message "Imported %d of %d star outline trees." count total)))
201
202 ;;;
203 ;;; Generic text file import or koutline insertion.
204 ;;;
205
206 ;;;###autoload
207 (defun kimport:text (import-from output-to &optional children-p)
208 "Insert text paragraphs from IMPORT-FROM into koutline OUTPUT-TO.
209 Displays and leaves point in OUTPUT-TO. See documentation for
210 `kimport:initialize' for valid values of IMPORT-FROM and OUTPUT-TO and for
211 an explanation of where imported cells are placed.
212
213 Text paragraphs are imported as a sequence of same level cells. Koutlines
214 are imported with their structure intact.
215
216 The variable, 'paragraph-start,' is used to determine paragraphs."
217 (interactive "FImport from text/koutline buffer/file: \nFInsert cells into koutline buffer/file: \nP")
218 (let ((klabel "1") (output-level 1) (count 0) initially-empty-output
219 no-renumber orig-point total)
220 ;; Don't change the order of import-from and output-to inits here.
221 (setq import-from (kimport:copy-and-set-buffer import-from)
222 output-to (kimport:initialize output-to)
223 orig-point (point)
224 initially-empty-output (zerop (- (point-max) (point-min)))
225 no-renumber (or initially-empty-output
226 (not (if children-p
227 (kcell-view:child-p)
228 (kcell-view:sibling-p)))))
229
230 (if (eq import-from output-to)
231 (error "(kimport:text): Import and output buffers may not be the same."))
232
233 (set-buffer import-from)
234 (let ((kotl-import (eq major-mode 'kotl-mode))
235 visible-cells)
236 (save-excursion
237 (if initially-empty-output
238 nil
239 ;; Insert first cell as sibling of current cell.
240 (set-buffer output-to)
241 (if children-p
242 ;; Insert as children.
243 (progn (setq klabel (klabel:child (kcell-view:label))
244 output-level (klabel:level klabel))
245 ;; Move to end of this cell since cell insertion will
246 ;; occur at point.
247 (goto-char (kcell-view:end)))
248 ;; Insert as successors.
249 (setq klabel (klabel:increment (kcell-view:label))
250 output-level (klabel:level klabel))
251 ;; Move to start of line of next tree since cell insertion will occur
252 ;; at point.
253 (goto-char (kotl-mode:tree-end)))
254 (set-buffer import-from))
255
256 (if kotl-import
257 ;; Importing from a koutline, so handle specially.
258 (progn (kotl-mode:beginning-of-buffer)
259 ;; Total number of cells.
260 (setq total (read (count-matches "[\n\r][\n\r]"))
261 visible-cells (read (count-matches "\n\n"))
262 count (save-excursion
263 ;; Incredible non-local exit to ensure that
264 ;; recursion ends at the right time.
265 (catch 'end
266 (kimport:kcells import-from output-to klabel
267 output-level 1
268 count total)))))
269
270 (show-all)
271 (goto-char (point-min))
272 ;; Total number of paragraphs.
273 (setq total (read (count-matches paragraph-start))
274 count (kimport:text-paragraphs import-from output-to klabel
275 output-level count total))))
276 (pop-to-buffer output-to)
277 (kfile:narrow-to-kcells)
278 (if no-renumber nil (klabel-type:update-labels klabel))
279 (goto-char orig-point)
280 (if (kotl-mode:buffer-empty-p)
281 nil
282 (kotl-mode:to-valid-position))
283 (if kotl-import
284 (message "Imported %d of %d visible cells from a %d cell outline."
285 count visible-cells total)
286 (message "Imported %d of %d paragraphs." count total)))))
287
288 ;;; ************************************************************************
289 ;;; Private functions - Don't call these functions from outside of this
290 ;;; module or you may misuse them and cause data corruption.
291 ;;; ************************************************************************
292
293 (defun kimport:aug-label-lessp (label1 label2)
294 "Return non-nil iff Augment-style LABEL1 is less than LABEL2."
295 (let ((lev1 (klabel:level-alpha label1))
296 (lev2 (klabel:level-alpha label2)))
297 (cond ((< lev1 lev2))
298 ((= lev1 lev2) (string-lessp label1 label2))
299 (t nil))))
300
301 (defun kimport:aug-post-statements (import-from output-to klabel output-level
302 import-level count total)
303 "Insert post-numbered Augment statements (contents only) from IMPORT-FROM into existing OUTPUT-TO.
304
305 KLABEL is the label to use for the first imported statement.
306 OUTPUT-LEVEL is the level at which to insert the first statement.
307 IMPORT-LEVEL is the depth of the current statement in the import file,
308 \(initially 1).
309
310 COUNT of inserted cells starts at 0. TOTAL is the total number of statements
311 in IMPORT-FROM, used to show a running tally of the imported statements."
312 (set-buffer import-from)
313 (let ((cell-end-regexp " +\\([0-9][0-9a-z]*\\)\n\\(\n+\\|\\'\\)")
314 contents start subtree-p end end-contents statement-level
315 child-label)
316 ;; While find cells at import-level or deeper ...
317 (while (and (setq start (point))
318 (re-search-forward cell-end-regexp nil t)
319 (<= import-level
320 (setq statement-level
321 (klabel:level-alpha
322 (buffer-substring
323 (match-beginning 1) (match-end 1))))))
324 (setq end-contents (match-beginning 0)
325 end (match-end 0))
326 (goto-char start)
327 (skip-chars-forward " ")
328 (setq contents (kimport:unindent-region (point) end-contents))
329 (goto-char end)
330 (setq subtree-p (save-excursion
331 (if (re-search-forward cell-end-regexp nil t)
332 (< statement-level
333 (klabel:level-alpha
334 (buffer-substring
335 (match-beginning 1) (match-end 1)))))))
336 (save-excursion
337 (set-buffer output-to)
338 ;; Add the cell starting at point.
339 (kview:add-cell klabel output-level contents nil t)
340 (if subtree-p (setq child-label (klabel:child klabel)))
341 (message "%d of %d statements converted..."
342 (setq count (1+ count)) total)
343 (setq klabel (klabel:increment klabel)))
344 ;;
345 ;; Current buffer returns to `import-from' here.
346 ;; Handle each sub-level through recursion.
347 (if subtree-p
348 ;; Subtree exists so insert its cells.
349 (setq count
350 (kimport:aug-post-statements
351 import-from output-to child-label (1+ output-level)
352 (1+ import-level) count total))))
353 (goto-char start))
354 count)
355
356 (defun kimport:copy-and-set-buffer (source)
357 "Copy and untabify SOURCE, set copy buffer as current buffer for this command and return the copy buffer.
358 SOURCE may be a buffer name, a buffer or a file name.
359 If SOURCE buffer name begins with a space, it is not copied under the
360 assumption that it already has been. If SOURCE is a koutline, it is not
361 copied since there is no need to copy it to import it."
362 ;; This buffer name format is used so that we can easily
363 ;; extract any file name suffix from the buffer name.
364 (setq source (set-buffer (or (get-buffer source)
365 (find-file-noselect source))))
366 (let ((mode (or (if (boundp 'kotl-previous-mode) kotl-previous-mode)
367 major-mode))
368 copy)
369 (if (or (eq mode 'kotl-mode)
370 (= ?\ (aref (buffer-name source) 0)))
371 source
372 (setq copy (get-buffer-create
373 (concat " " (if (string-match ".+[|<]" (buffer-name))
374 (substring (buffer-name)
375 0 (1- (match-end 0)))
376 (buffer-name)))))
377 (set-buffer copy)
378 (setq buffer-read-only nil
379 major-mode mode)
380 (erase-buffer)
381 (insert-buffer source)
382 (untabify (point-min) (point-max))
383 ;; Ensure buffer ends with a newline so that we don't miss the last
384 ;; element during the import.
385 (goto-char (point-max))
386 (if (/= (preceding-char) ?\n) (insert "\n"))
387 (set-buffer-modified-p nil)
388 copy)))
389
390 (defun kimport:initialize (output-to)
391 "Setup to import elements into koutline OUTPUT-TO.
392 Return OUTPUT-TO buffer and set current buffer for the current command
393 to OUTPUT-TO.
394
395 OUTPUT-TO may be a buffer, buffer-name or file name. If OUTPUT-TO exists
396 already, it must be a koutline or an error will be signaled. For an existing
397 OUTPUT-TO, the text cells are inserted after the cell at point or after the
398 first cell for a newly loaded koutline. If OUTPUT-TO is nil, the current
399 buffer is used.
400
401 If OUTPUT-TO is an existing koutline, the first cell imported will be added
402 as the successor of the current cell. If an existing file is read in as
403 OUTPUT-TO within this function, point is left at the end of this buffer so
404 that imported cells will be appended to the buffer. For a new file, this
405 means the first cell imported will become the first outline cell.
406
407 If a non-nil third argument, CHILDREN-P, is given to the caller of this
408 function and OUTPUT-TO contains at least one cell, then the imported cells
409 will be added as children of the cell where this function leaves point
410 \(either the current cell or for a newly read in outline, the last cell)."
411 (let* ((output-existing-buffer-p
412 (if output-to
413 (or (get-buffer output-to) (get-file-buffer output-to))))
414 (output-exists-p
415 (if output-to
416 (or output-existing-buffer-p (file-exists-p output-to))
417 ;; current buffer will be used for output and it exists.
418 t)))
419 (setq output-to (if output-to
420 (or (get-buffer output-to)
421 (find-file-noselect output-to))
422 (current-buffer)))
423 (set-buffer output-to)
424 (if output-exists-p
425 (if (eq major-mode 'kotl-mode)
426 (if (kotl-mode:buffer-empty-p)
427 nil
428 ;; Make imported cells be appended if the output buffer was
429 ;; just read in.
430 (if output-existing-buffer-p nil (goto-char (point-max)))
431 (kotl-mode:to-valid-position))
432 (error
433 "(kimport:initialize): Second arg, %s, must be a koutline file."
434 (buffer-name output-to)))
435 (if (eq major-mode 'kotl-mode)
436 nil
437 (setq kview nil)
438 (kotl-mode))
439 (delete-region (point-min) (point-max))))
440 output-to)
441
442 (defun kimport:kcells (import-from output-to klabel output-level
443 import-level count total)
444 "Insert visible koutline cells (contents and attributes) from IMPORT-FROM into existing OUTPUT-TO.
445
446 KLABEL is the label to use for the first imported cell.
447 OUTPUT-LEVEL is the level at which to insert the first cell.
448 IMPORT-LEVEL is the depth of the current cell in the import file,
449 \(initially 1).
450
451 COUNT of inserted cells starts at 0. TOTAL is the total number of cells
452 in IMPORT-FROM, used to show a running tally of the imported cells."
453 (set-buffer import-from)
454 (goto-char (kcell-view:start))
455 (let ((again t) contents subtree-p child-label)
456 ;; While find cells at import-level or deeper ...
457 (while (<= import-level (kcell-view:level))
458 (setq subtree-p (kcell-view:child-p nil t)
459 contents (kcell-view:contents))
460 (goto-char (kcell-view:end-contents))
461 (save-excursion
462 (set-buffer output-to)
463 ;; Add the cell starting at point.
464 (kview:add-cell klabel output-level contents nil t)
465 (if subtree-p (setq child-label (klabel:child klabel)))
466 (message "%d of %d cells inserted..."
467 (setq count (1+ count)) total)
468 (setq klabel (klabel:increment klabel)))
469 ;;
470 ;; Current buffer returns to `import-from' here.
471 ;; Handle each sub-level through recursion.
472 (if (and (setq again (kcell-view:next t)) subtree-p)
473 ;; Subtree exists so insert its cells.
474 (setq count
475 (kimport:kcells
476 import-from output-to child-label (1+ output-level)
477 (1+ import-level) count total)))
478 (if again nil (throw 'end count))))
479 count)
480
481 (defun kimport:star-entries (import-from output-to klabel output-level
482 import-level count total)
483 "Insert visible star outline entries from IMPORT-FROM into existing OUTPUT-TO.
484
485 KLABEL is the label to use for the first imported entry.
486 OUTPUT-LEVEL is the level at which to insert the first entry.
487 IMPORT-LEVEL is the depth of the current entry in the import file,
488 \(initially 1).
489
490 COUNT of inserted entries starts at 0. TOTAL is the total number of entries
491 in IMPORT-FROM, used to show a running tally of the imported entries."
492 (set-buffer import-from)
493 (let ((start (point))
494 (rolo-entry-regexp "^[ \t]*\\(\\*+\\)")
495 subtree-p end contents node-level child-label)
496 ;; While find cells at import-level or deeper ...
497 (while (and (re-search-forward rolo-entry-regexp nil t)
498 (<= import-level
499 (setq node-level
500 (length
501 (buffer-substring
502 (match-beginning 1) (match-end 1))))))
503 (skip-chars-forward " \t")
504 (setq start (point)
505 end (rolo-to-entry-end)
506 subtree-p (if (looking-at rolo-entry-regexp)
507 (< node-level
508 (length (buffer-substring
509 (match-beginning 1) (match-end 1))))))
510 (skip-chars-backward "\n\r")
511 (setq contents (kimport:unindent-region start (point)))
512 (save-excursion
513 (set-buffer output-to)
514 ;; Add the cell starting at point.
515 (kview:add-cell klabel output-level contents nil t)
516 (if subtree-p (setq child-label (klabel:child klabel)))
517 (message "%d of %d trees converted..."
518 (if (= node-level 1) (setq count (1+ count)) count)
519 total)
520 (setq klabel (klabel:increment klabel)))
521 ;;
522 ;; Current buffer returns to `import-from' here.
523 (goto-char end)
524 ;;
525 ;; Handle each sub-level through recursion.
526 (if subtree-p
527 ;; Subtree exists so insert its cells.
528 (setq count
529 (kimport:star-entries import-from output-to child-label
530 (1+ output-level) (1+ import-level)
531 count total))))
532 (goto-char start))
533 count)
534
535 (defun kimport:text-paragraphs (import-from output-to klabel
536 output-level count total)
537 "Insert text paragraphs from IMPORT-FROM into existing OUTPUT-TO.
538 First cell is inserted with KLABEL at OUTPUT-LEVEL, as the sibling of the
539 previous cell, with the COUNT of inserted paragraphs starting at 0. TOTAL is
540 the total number of paragraphs in IMPORT-FROM, used to show a running tally
541 of the imported paragraphs.
542
543 The variable, 'paragraph-start' is used to determine paragraphs."
544 (set-buffer import-from)
545 (let* ((count 0) start end contents)
546 ;; Next line is needed when importing into an existing kview.
547 (goto-char (point-min))
548 ;; Move past blank lines at point.
549 (skip-chars-forward " \t\n\r")
550 (beginning-of-line)
551 (while (and (setq start (point)
552 end (re-search-forward paragraph-start nil t))
553 (/= start end))
554 (setq contents (kimport:unindent-region start end))
555 (set-buffer output-to)
556 ;; Add the cell starting at point.
557 (kview:add-cell klabel output-level contents nil t)
558 (setq count (1+ count))
559 (message "%d of %d paragraphs converted..."
560 count total)
561 (setq klabel (klabel:increment klabel))
562 (set-buffer import-from)
563 (goto-char end)
564 ;; Move past blank lines separating paragraphs.
565 (skip-chars-forward " \t\n\r")
566 (beginning-of-line))
567 (message "%d of %d paragraphs converted" count total)
568 count))
569
570 (defun kimport:unindent-region (start end)
571 "Calculate indent based upon the second line within the region START to END.
572 Remove the indent and return the remaining region as a string."
573 (save-excursion
574 (let (indent-regexp)
575 (goto-char start)
576 ;; Remove leading indent from lines in paragraph. Base paragraph
577 ;; indent on the 2nd paragraph line since the first line might be
578 ;; further indented or outdented.
579 (setq indent-regexp
580 (if (re-search-forward "[\n\r][ \t]+" end t)
581 (concat "^" (make-string (current-column) ?\ ))))
582 (if indent-regexp
583 (hypb:replace-match-string
584 indent-regexp (buffer-substring start end) "" t)
585 (buffer-substring start end)))))
586
587 (provide 'kimport)
588