|
0
|
1 ;;!emacs
|
|
|
2 ;;
|
|
|
3 ;; FILE: kfile.el
|
|
|
4 ;; SUMMARY: Save and restore kotls from files.
|
|
|
5 ;; USAGE: GNU Emacs V19 Lisp Library
|
|
|
6 ;; KEYWORDS: outlines, wp
|
|
|
7 ;;
|
|
|
8 ;; AUTHOR: Bob Weiner & Kellie Clark
|
|
|
9 ;;
|
|
|
10 ;; ORIG-DATE: 10/31/93
|
|
36
|
11 ;; LAST-MOD: 6-Mar-97 at 01:17:51 by Bob Weiner
|
|
|
12
|
|
0
|
13 ;;; ************************************************************************
|
|
|
14 ;;; Other required Elisp libraries
|
|
|
15 ;;; ************************************************************************
|
|
|
16
|
|
|
17 (mapcar 'require '(kproperty kotl-mode))
|
|
|
18
|
|
|
19 ;; Loads menus under non-tty InfoDock, XEmacs or Emacs19; does nothing
|
|
|
20 ;; otherwise.
|
|
|
21 (and (not (featurep 'kmenu)) hyperb:window-system
|
|
|
22 (or hyperb:lemacs-p hyperb:emacs19-p) (require 'kmenu))
|
|
|
23
|
|
|
24 ;;; ************************************************************************
|
|
|
25 ;;; Public variables
|
|
|
26 ;;; ************************************************************************
|
|
|
27
|
|
|
28 (defconst kfile:version "Kotl-4.0"
|
|
|
29 "Version number of persistent data format used for saving koutlines.")
|
|
|
30
|
|
|
31 ;;; ************************************************************************
|
|
|
32 ;;; Entry Points
|
|
|
33 ;;; ************************************************************************
|
|
|
34
|
|
|
35 ;;;###autoload
|
|
|
36 (defun kfile:find (file-name)
|
|
|
37 "Find a file FILE-NAME containing a kotl or create one if none exists.
|
|
|
38 Return the new kview."
|
|
|
39 (interactive
|
|
|
40 (list (kfile:read-name
|
|
|
41 "Find koutline file: " nil)))
|
|
|
42 (let ((existing-file (file-exists-p file-name))
|
|
|
43 buffer)
|
|
|
44 (and existing-file
|
|
|
45 (not (file-readable-p file-name))
|
|
|
46 (error
|
|
|
47 "(kfile:find): \"%s\" is not readable. Check permissions."
|
|
|
48 file-name))
|
|
|
49 (setq buffer (find-file file-name))
|
|
|
50 ;; Finding the file may have already done a kfile:read as invoked through
|
|
|
51 ;; kotl-mode via a file local variable setting. If so, don't read it
|
|
|
52 ;; again.
|
|
|
53 (if (kview:is-p kview)
|
|
|
54 nil
|
|
|
55 (kfile:read buffer existing-file))
|
|
|
56 (or (eq major-mode 'kotl-mode) (kotl-mode))
|
|
|
57 kview))
|
|
|
58
|
|
|
59 ;;;###autoload
|
|
|
60 (defun kfile:view (file-name)
|
|
|
61 "View an existing kotl version-2 file FILE-NAME in a read-only mode."
|
|
|
62 (interactive
|
|
|
63 (list (kfile:read-name
|
|
|
64 "View koutline file: " t)))
|
|
|
65 (let ((existing-file (file-exists-p file-name)))
|
|
|
66 (if existing-file
|
|
|
67 (if (not (file-readable-p file-name))
|
|
|
68 (error
|
|
|
69 "(kfile:view): \"%s\" is not readable. Check permissions."
|
|
|
70 file-name))
|
|
|
71 (error "(kfile:view): \"%s\" does not exist."))
|
|
|
72 (view-file file-name))
|
|
|
73 (kfile:narrow-to-kcells)
|
|
|
74 (goto-char (point-min)))
|
|
|
75
|
|
|
76 ;;; ************************************************************************
|
|
|
77 ;;; Public functions
|
|
|
78 ;;; ************************************************************************
|
|
|
79
|
|
|
80 (defun kfile:create (buffer)
|
|
|
81 "Create a new koutline file attached to BUFFER, with a single empty level 1 kotl cell.
|
|
|
82 Return file's kview."
|
|
|
83 (or buffer (setq buffer (current-buffer)))
|
|
|
84 (if (not (bufferp buffer))
|
|
|
85 (error "(kfile:create): Invalid buffer argument, %s" buffer))
|
|
|
86 (set-buffer buffer)
|
|
|
87 (if buffer-read-only
|
|
|
88 (error "(kfile:create): %s is read-only" buffer))
|
|
|
89 (widen)
|
|
|
90
|
|
|
91 (let ((empty-p (zerop (buffer-size)))
|
|
|
92 import-from view standard-output)
|
|
|
93
|
|
|
94 (if (not empty-p)
|
|
|
95 ;; This is a foreign file whose elements must be converted into
|
|
|
96 ;; koutline cells.
|
|
|
97 (progn (setq import-from (kimport:copy-and-set-buffer buffer))
|
|
|
98 (set-buffer buffer)
|
|
|
99 (erase-buffer))) ;; We copied the contents to `import-from'.
|
|
|
100
|
|
|
101 (setq view (kview:create (buffer-name buffer))
|
|
|
102 standard-output (current-buffer))
|
|
|
103 (goto-char (point-min))
|
|
|
104 (princ ";; -*- Mode: kotl -*- \n")
|
|
|
105 (prin1 kfile:version)
|
|
|
106 (princ " ;; file-format\n\^_\n")
|
|
|
107 ;; Ensure that last cell has two newlines after it so that
|
|
|
108 ;; kfile:insert-attributes finds it.
|
|
|
109 (goto-char (point-max))
|
|
|
110 (princ "\n\n\^_\n")
|
|
|
111 (princ "\^_\n;; depth-first kcell attributes\n")
|
|
|
112 ;; Ensure that display is narrowed to cell region only.
|
|
|
113 (kfile:narrow-to-kcells)
|
|
|
114 (goto-char (point-min))
|
|
|
115 (if empty-p
|
|
|
116 ;; This is a new koutline file. Always need at least one visible
|
|
|
117 ;; cell within a view. Insert initial empty cell.
|
|
|
118 (progn (kview:add-cell "1" 1)
|
|
|
119 ;; Mark view unmodified, so if kill right away, there is no
|
|
|
120 ;; prompt.
|
|
|
121 (set-buffer-modified-p nil)
|
|
|
122 ;; Move to first cell.
|
|
|
123 (goto-char (point-min))
|
|
|
124 (goto-char (kcell-view:start)))
|
|
|
125 ;; Import buffer. Next line is necessary or the importation will fail.
|
|
|
126 (delete-region (point-min) (point-max))
|
|
|
127 ;; Import foreign buffer as koutline cells.
|
|
|
128 (kimport:file import-from (current-buffer))
|
|
|
129 ;; If import buffer name starts with a space, kill it, as it is no
|
|
|
130 ;; longer needed.
|
|
|
131 (if (= ?\ (aref (buffer-name import-from) 0))
|
|
|
132 (kill-buffer import-from)))
|
|
|
133
|
|
|
134 view))
|
|
|
135
|
|
|
136 ;;;###autoload
|
|
|
137 (defun kfile:is-p ()
|
|
|
138 "Iff current buffer contains an unformatted or formatted koutline, return file format version string, else nil."
|
|
|
139 (let (ver-string)
|
|
|
140 (save-excursion
|
|
|
141 (save-restriction
|
|
|
142 (widen)
|
|
|
143 (goto-char (point-min))
|
|
|
144 (condition-case ()
|
|
|
145 (progn
|
|
|
146 (setq ver-string (read (current-buffer)))
|
|
|
147 (and (stringp ver-string) (string-match "^Kotl-" ver-string)
|
|
|
148 ver-string))
|
|
|
149 (error nil))))))
|
|
|
150
|
|
|
151 (defun kfile:read (buffer existing-file-p)
|
|
|
152 "Create a new kotl view by reading BUFFER or create an empty view when EXISTING-FILE-P is nil.
|
|
|
153 Return the new view."
|
|
|
154 (let (ver-string)
|
|
|
155 (cond ((not (bufferp buffer))
|
|
36
|
156 (error "(kfile:read): Argument must be a buffer, `%s'." buffer))
|
|
0
|
157 ((not existing-file-p)
|
|
|
158 (kfile:create buffer))
|
|
|
159 ((progn
|
|
|
160 (set-buffer buffer)
|
|
|
161 (not (setq ver-string (kfile:is-p))))
|
|
36
|
162 (error "(kfile:read): `%s' is not a koutline file." buffer))
|
|
0
|
163 ((equal ver-string "Kotl-4.0")
|
|
|
164 (kfile:read-v4-or-v3 buffer nil))
|
|
|
165 ((equal ver-string "Kotl-3.0")
|
|
|
166 (kfile:read-v4-or-v3 buffer t))
|
|
|
167 ((equal ver-string "Kotl-2.0")
|
|
|
168 (kfile:read-v2 buffer))
|
|
|
169 ((equal ver-string "Kotl-1.0")
|
|
|
170 (error "(kfile:read): V1 koutlines are no longer supported"))
|
|
36
|
171 (t (error "(kfile:read): `%s' has unknown kotl version, %s."
|
|
0
|
172 buffer ver-string)))))
|
|
|
173
|
|
|
174 (defun kfile:read-v2 (buffer)
|
|
|
175 "Create a kotl view by reading kotl version-2 BUFFER. Return the new view."
|
|
|
176 (let ((standard-input buffer)
|
|
|
177 cell-count label-type label-min-width label-separator
|
|
|
178 level-indent cell-data kotl-structure view kcell-list)
|
|
|
179 (widen)
|
|
|
180 (goto-char (point-min))
|
|
|
181 ;; Skip past cell contents here.
|
|
|
182 (search-forward "\n\^_" nil t 2)
|
|
|
183 ;; Read rest of file data.
|
|
|
184 (setq cell-count (read)
|
|
|
185 label-type (read)
|
|
|
186 label-min-width (read)
|
|
|
187 label-separator (read)
|
|
|
188 level-indent (read)
|
|
|
189 cell-data (read)
|
|
|
190 kotl-structure (read))
|
|
|
191 ;;
|
|
|
192 ;; kcell-list is a depth-first list of kcells to be attached to the cell
|
|
|
193 ;; contents within the kview down below.
|
|
|
194 (setq kcell-list (kfile:build-structure-v2 kotl-structure cell-data)
|
|
|
195 view (kview:create (buffer-name buffer) cell-count label-type
|
|
|
196 level-indent label-separator label-min-width))
|
|
|
197 ;;
|
|
|
198 (kfile:narrow-to-kcells)
|
|
|
199 (goto-char (point-min))
|
|
|
200 ;;
|
|
|
201 ;; Add attributes to cells.
|
|
|
202 (kfile:insert-attributes-v2 view kcell-list)
|
|
|
203 ;;
|
|
|
204 ;; Mark view unmodified and move to first cell.
|
|
|
205 (set-buffer-modified-p nil)
|
|
|
206 (goto-char (point-min))
|
|
|
207 (goto-char (kcell-view:start))
|
|
|
208 view))
|
|
|
209
|
|
|
210 (defun kfile:read-v4-or-v3 (buffer v3-flag)
|
|
|
211 "Create a koutline view by reading version-4 BUFFER. Return the new view.
|
|
|
212 If V3-FLAG is true, read as a version-3 buffer."
|
|
|
213 (let ((standard-input buffer)
|
|
|
214 cell-count label-type label-min-width label-separator
|
|
|
215 level-indent cell-data view)
|
|
|
216 (widen)
|
|
|
217 (goto-char (point-min))
|
|
|
218 ;; Skip past cell contents here.
|
|
|
219 (search-forward "\n\^_" nil t 2)
|
|
|
220 ;; Read rest of file data.
|
|
|
221 (if v3-flag
|
|
|
222 nil ;; V3 files did not store viewspecs.
|
|
|
223 (kvspec:initialize)
|
|
|
224 (setq kvspec:current (read)))
|
|
|
225 (setq cell-count (read)
|
|
|
226 label-type (read)
|
|
|
227 label-min-width (read)
|
|
|
228 label-separator (read)
|
|
|
229 level-indent (read)
|
|
|
230 cell-data (read))
|
|
|
231 ;;
|
|
|
232 (setq view (kview:create (buffer-name buffer) cell-count label-type
|
|
|
233 level-indent label-separator label-min-width))
|
|
|
234 ;;
|
|
|
235 (kfile:narrow-to-kcells)
|
|
|
236 (goto-char (point-min))
|
|
|
237 ;;
|
|
|
238 ;; Add attributes to cells.
|
|
|
239 (kfile:insert-attributes-v3 view cell-data)
|
|
|
240 ;;
|
|
|
241 ;; Mark view unmodified and move to first cell.
|
|
|
242 (set-buffer-modified-p nil)
|
|
|
243 (goto-char (point-min))
|
|
|
244 (goto-char (kcell-view:start))
|
|
|
245 view))
|
|
|
246
|
|
|
247 (defun kfile:update (&optional visible-only-p)
|
|
|
248 "Update kfile internal structure so that view is ready for saving to a file.
|
|
|
249 Leave outline file expanded with structure data showing unless optional
|
|
|
250 VISIBLE-ONLY-P is non-nil. Signal an error if kotl is not attached to a file."
|
|
|
251 (let* ((top (kview:top-cell kview))
|
|
|
252 (file (kcell:get-attr top 'file))
|
|
|
253 (label-type (kview:label-type kview))
|
|
|
254 (label-min-width (kview:label-min-width kview))
|
|
|
255 (label-separator (kview:label-separator kview))
|
|
|
256 (level-indent (kview:level-indent kview))
|
|
|
257 ;; If this happens to be non-nil, it is virtually impossible to save
|
|
|
258 ;; a file, so ensure it is nil.
|
|
|
259 (debug-on-error))
|
|
|
260 (cond ((null file)
|
|
|
261 (error "(kfile:update): Current outline is not attached to a file."))
|
|
|
262 ((not (file-writable-p file))
|
|
|
263 (error "(kfile:update): File \"%s\" is not writable." file)))
|
|
|
264 (let* ((buffer-read-only)
|
|
|
265 (id-counter (kcell:get-attr top 'id-counter))
|
|
|
266 (kotl-data (make-vector (1+ id-counter) nil))
|
|
|
267 (standard-output (current-buffer))
|
|
|
268 (opoint (set-marker (make-marker) (point)))
|
|
|
269 (kcell-num 1)
|
|
|
270 cell)
|
|
|
271 ;;
|
|
|
272 ;; Prepare cell data for saving.
|
|
|
273 (kfile:narrow-to-kcells)
|
|
|
274 (kview:map-tree
|
|
|
275 (function
|
|
|
276 (lambda (view)
|
|
|
277 (setq cell (kcell-view:cell))
|
|
|
278 (aset kotl-data
|
|
|
279 kcell-num
|
|
|
280 (kotl-data:create cell))
|
|
|
281 (setq kcell-num (1+ kcell-num))))
|
|
|
282 kview t)
|
|
|
283 ;; Save top cell, 0, last since above loop may increment the total
|
|
|
284 ;; number of cells counter stored in it, if any invalid cells are
|
|
|
285 ;; encountered.
|
|
|
286 (aset kotl-data 0 (kotl-data:create top))
|
|
|
287 (setq id-counter (kcell:get-attr top 'id-counter))
|
|
|
288 ;;
|
|
|
289 (widen)
|
|
|
290 (goto-char (point-min))
|
|
|
291 (if (search-forward "\n\^_\n" nil t)
|
|
|
292 (delete-region (point-min) (match-end 0)))
|
|
|
293 (princ ";; -*- Mode: kotl -*- \n")
|
|
|
294 (prin1 kfile:version)
|
|
|
295 (princ " ;; file-format\n\^_\n")
|
|
|
296 ;; Skip past cells.
|
|
|
297 (if (search-forward "\n\^_\n" nil t)
|
|
|
298 ;; Get rid of excess blank lines after last cell.
|
|
|
299 (progn (goto-char (match-beginning 0))
|
|
|
300 (skip-chars-backward "\n")
|
|
|
301 (delete-region (point) (point-max)))
|
|
|
302 (goto-char (point-max)))
|
|
|
303 ;; Ensure that last cell has two newlines after it so that
|
|
|
304 ;; kfile:insert-attributes finds it.
|
|
|
305 (princ "\n\n\^_\n")
|
|
|
306 (princ (format (concat
|
|
|
307 "%S ;; kvspec:current\n%d ;; id-counter\n"
|
|
|
308 "%S ;; label-type\n%d ;; label-min-width\n"
|
|
|
309 "%S ;; label-separator\n%d ;; level-indent\n")
|
|
|
310 kvspec:current id-counter label-type label-min-width
|
|
|
311 label-separator level-indent))
|
|
|
312 (princ "\^_\n;; depth-first kcell attributes\n")
|
|
|
313 (kfile:pretty-print kotl-data)
|
|
|
314 ;;
|
|
|
315 ;; Don't re-narrow buffer by default since this is used in
|
|
|
316 ;; write-contents-hooks after save-buffer has widened buffer. If
|
|
|
317 ;; buffer is narrowed here, only the narrowed portion will be saved to
|
|
|
318 ;; the file. Narrow as an option since saving only the portion of the
|
|
|
319 ;; file visible in a view may be useful in some situations.
|
|
|
320 (if visible-only-p (kfile:narrow-to-kcells))
|
|
|
321 ;;
|
|
|
322 ;; Return point to its original position as given by the opoint marker.
|
|
|
323 (goto-char opoint)
|
|
|
324 (set-marker opoint nil)
|
|
|
325 nil)))
|
|
|
326
|
|
36
|
327 ;;; Next function is adapted from `file-write' of GNU Emacs 19, copyright FSF,
|
|
0
|
328 ;;; under the GPL.
|
|
|
329 (defun kfile:write (file)
|
|
|
330 "Write current outline to FILE."
|
|
|
331 (interactive "FWrite outline file: ")
|
|
|
332 (if (or (null file) (string-equal file ""))
|
|
|
333 (error "(kfile:write): Invalid file name, \"%s\"" file))
|
|
|
334 ;; If arg is just a directory, use same file name, but in that directory.
|
|
|
335 (if (and (file-directory-p file) buffer-file-name)
|
|
|
336 (setq file (concat (file-name-as-directory file)
|
|
|
337 (file-name-nondirectory buffer-file-name))))
|
|
|
338 (kcell:set-attr (kview:top-cell kview) 'file file)
|
|
|
339 (set-visited-file-name file)
|
|
|
340 ;; Set-visited-file-name clears local-write-file-hooks that we use to save
|
|
|
341 ;; koutlines properly, so reinitialize local variables.
|
|
|
342 (kotl-mode)
|
|
|
343 (set-buffer-modified-p t)
|
|
|
344 ;; This next line must come before the save-buffer since write-file-hooks
|
|
|
345 ;; can make use of it.
|
|
|
346 (kview:set-buffer-name kview (buffer-name))
|
|
|
347 (save-buffer))
|
|
|
348
|
|
|
349 ;;; ************************************************************************
|
|
|
350 ;;; Private functions
|
|
|
351 ;;; ************************************************************************
|
|
|
352
|
|
|
353 (defun kfile:build-structure-v2 (kotl-structure cell-data)
|
|
|
354 "Build cell list from the KOTL-STRUCTURE and its CELL-DATA.
|
|
|
355 Assumes all arguments are valid. CELL-DATA is a vector of cell fields read
|
|
|
356 from a koutline file.
|
|
|
357
|
|
|
358 Return list of outline cells in depth first order. Invisible top cell is not
|
|
|
359 included in the list."
|
|
|
360 (let ((stack) (sibling-p) (cell-list) func cell)
|
|
|
361 (mapcar
|
|
|
362 (function
|
|
|
363 (lambda (item)
|
|
|
364 (setq func (cdr (assoc item
|
|
|
365 (list
|
|
|
366 (cons "\("
|
|
|
367 (function
|
|
|
368 (lambda ()
|
|
|
369 (setq stack (cons sibling-p stack)
|
|
|
370 sibling-p nil))))
|
|
|
371 (cons "\)"
|
|
|
372 (function
|
|
|
373 (lambda ()
|
|
|
374 (setq sibling-p (car stack)
|
|
|
375 stack (cdr stack)))))))))
|
|
|
376 (cond (func (funcall func))
|
|
|
377 ;; 0th cell was created with kview:create.
|
|
|
378 ((equal item 0) nil)
|
|
|
379 (t (setq cell (kotl-data:to-kcell-v2 (aref cell-data item))
|
|
|
380 cell-list (cons cell cell-list)
|
|
|
381 sibling-p t)
|
|
|
382 ))))
|
|
|
383 kotl-structure)
|
|
|
384 (nreverse cell-list)))
|
|
|
385
|
|
|
386 (defun kfile:insert-attributes-v2 (kview kcell-list)
|
|
|
387 "Set cell attributes within kview for each element in KCELL-LIST.
|
|
|
388 Assumes all cell contents are already in kview and that no cells are
|
|
|
389 hidden."
|
|
|
390 (let (buffer-read-only)
|
|
|
391 (while
|
|
|
392 (progn
|
|
|
393 (skip-chars-forward "\n")
|
|
|
394 ;; !!! Won't work if label-type is 'no.
|
|
|
395 ;; Here we search past the cell identifier
|
|
|
396 ;; for the location at which to place cell properties.
|
|
|
397 ;; Be sure not to skip past a period which may terminate the label.
|
|
|
398 (if (re-search-forward "[A-Za-z0-9]\\(\\.?[A-Za-z0-9]\\)*" nil t)
|
|
|
399 (progn
|
|
|
400 (kproperty:set 'kcell (car kcell-list))
|
|
|
401 (setq kcell-list (cdr kcell-list))))
|
|
|
402 (search-forward "\n\n" nil t)))))
|
|
|
403
|
|
|
404 (defun kfile:insert-attributes-v3 (kview kcell-vector)
|
|
|
405 "Set cell attributes within kview for each element in KCELL-VECTOR.
|
|
|
406 Assumes all cell contents are already in kview and that no cells are
|
|
|
407 hidden."
|
|
|
408 (let ((kcell-num 1)
|
|
|
409 (buffer-read-only))
|
|
|
410 (while
|
|
|
411 (progn
|
|
|
412 (skip-chars-forward "\n")
|
|
|
413 ;; !!! Won't work if label-type is 'no.
|
|
|
414 ;; Here we search past the cell identifier
|
|
|
415 ;; for the location at which to place cell properties.
|
|
|
416 ;; Be sure not to skip past a period which may terminate the label.
|
|
|
417 (if (re-search-forward "[A-Za-z0-9]\\(\\.?[A-Za-z0-9]\\)*" nil t)
|
|
|
418 (progn
|
|
|
419 (kproperty:set 'kcell
|
|
|
420 (kotl-data:to-kcell-v3
|
|
|
421 (aref kcell-vector kcell-num)))
|
|
|
422 (setq kcell-num (1+ kcell-num))))
|
|
|
423 (search-forward "\n\n" nil t)))))
|
|
|
424
|
|
|
425 (defun kfile:narrow-to-kcells ()
|
|
|
426 "Narrow kotl file to kcell section only."
|
|
|
427 (interactive)
|
|
|
428 (if (kview:is-p kview)
|
|
|
429 (let ((start-text) (end-text))
|
|
|
430 (save-excursion
|
|
|
431 (widen)
|
|
|
432 (goto-char (point-min))
|
|
|
433 ;; Skip to start of kcells.
|
|
|
434 (if (search-forward "\n\^_" nil t)
|
|
|
435 (setq start-text (1+ (match-end 0))))
|
|
|
436 ;; Skip past end of kcells.
|
|
|
437 (if (and start-text (search-forward "\n\^_" nil t))
|
|
|
438 (setq end-text (1+ (match-beginning 0))))
|
|
|
439 (if (and start-text end-text)
|
|
|
440 (progn (narrow-to-region start-text end-text)
|
|
|
441 (goto-char (point-min)))
|
|
|
442 (error
|
|
|
443 "(kfile:narrow-to-kcells): Cannot find start or end of kcells"))
|
|
|
444 ))))
|
|
|
445
|
|
|
446 (defun kfile:print-to-string (object)
|
|
|
447 "Return a string containing OBJECT, any Lisp object, in pretty-printed form.
|
|
|
448 Quoting characters are used when needed to make output that `read' can
|
|
|
449 handle, whenever this is possible."
|
|
|
450 (save-excursion
|
|
|
451 (set-buffer (get-buffer-create " kfile:print-to-string"))
|
|
|
452 (let ((emacs-lisp-mode-hook)
|
|
|
453 (buffer-read-only))
|
|
|
454 (erase-buffer)
|
|
|
455 (unwind-protect
|
|
|
456 (progn
|
|
|
457 (emacs-lisp-mode)
|
|
|
458 (let ((print-escape-newlines kfile:escape-newlines))
|
|
|
459 (prin1 object (current-buffer)))
|
|
|
460 (goto-char (point-min))
|
|
|
461 (while (not (eobp))
|
|
|
462 ;; (message "%06d" (- (point-max) (point)))
|
|
|
463 (cond
|
|
|
464 ((looking-at "\\s\(")
|
|
|
465 (while (looking-at "\\s(")
|
|
|
466 (forward-char 1)))
|
|
|
467 ((and (looking-at "\\(quote[ \t]+\\)\\([^.)]\\)")
|
|
|
468 (> (match-beginning 1) 1)
|
|
|
469 (= ?\( (char-after (1- (match-beginning 1))))
|
|
|
470 ;; Make sure this is a two-element list.
|
|
|
471 (save-excursion
|
|
|
472 (goto-char (match-beginning 2))
|
|
|
473 (forward-sexp)
|
|
|
474 ;; (looking-at "[ \t]*\)")
|
|
|
475 ;; Avoid mucking with match-data; does this test work?
|
|
|
476 (char-equal ?\) (char-after (point)))))
|
|
|
477 ;; -1 gets the paren preceding the quote as well.
|
|
|
478 (delete-region (1- (match-beginning 1)) (match-end 1))
|
|
|
479 (insert "'")
|
|
|
480 (forward-sexp 1)
|
|
|
481 (if (looking-at "[ \t]*\)")
|
|
|
482 (delete-region (match-beginning 0) (match-end 0))
|
|
|
483 (error "Malformed quote"))
|
|
|
484 (backward-sexp 1))
|
|
|
485 ((condition-case ()
|
|
|
486 (prog1 t (down-list 1))
|
|
|
487 (error nil))
|
|
|
488 (backward-char 1)
|
|
|
489 (skip-chars-backward " \t")
|
|
|
490 (delete-region
|
|
|
491 (point)
|
|
|
492 (progn (skip-chars-forward " \t") (point)))
|
|
|
493 (if (not (char-equal ?' (char-after (1- (point)))))
|
|
|
494 (insert ?\n)))
|
|
|
495 ((condition-case ()
|
|
|
496 (prog1 t (up-list 1))
|
|
|
497 (error nil))
|
|
|
498 (while (looking-at "\\s)")
|
|
|
499 (forward-char 1))
|
|
|
500 (skip-chars-backward " \t")
|
|
|
501 (delete-region
|
|
|
502 (point)
|
|
|
503 (progn (skip-chars-forward " \t") (point)))
|
|
|
504 (if (not (char-equal ?' (char-after (1- (point)))))
|
|
|
505 (insert ?\n)))
|
|
|
506 (t (goto-char (point-max)))))
|
|
|
507 (goto-char (point-min))
|
|
|
508 (indent-sexp)
|
|
|
509 (buffer-string))
|
|
|
510 (kill-buffer (current-buffer))))))
|
|
|
511
|
|
|
512 (defun kfile:pretty-print (object &optional stream)
|
|
|
513 "Output the pretty-printed representation of OBJECT, any Lisp object.
|
|
|
514 Quoting characters are printed when needed to make output that `read'
|
|
|
515 can handle, whenever this is possible.
|
|
|
516 Output stream is STREAM, or value of `standard-output' (which see)."
|
|
|
517 (princ (kfile:print-to-string object) (or stream standard-output)))
|
|
|
518
|
|
|
519 (defun kfile:read-name (prompt existing-p)
|
|
|
520 "PROMPT for and read a koutline file name. EXISTING-P means must exist."
|
|
|
521 (let ((filename))
|
|
|
522 (while (not filename)
|
|
|
523 (setq filename (read-file-name prompt nil nil existing-p))
|
|
|
524 (if (or (null filename) (equal filename ""))
|
|
|
525 (progn (ding) (setq filename nil))))
|
|
|
526 filename))
|
|
|
527
|
|
|
528 ;;; ************************************************************************
|
|
|
529 ;;; Private variables
|
|
|
530 ;;; ************************************************************************
|
|
|
531
|
|
|
532 (defvar kfile:escape-newlines t
|
|
36
|
533 "Value of print-escape-newlines used by `kfile:print-to-string' function.")
|
|
0
|
534
|
|
|
535 (provide 'kfile)
|
