Mercurial > hg > xemacs-beta
comparison lisp/hyperbole/kotl/kotl-mode.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:45:50 +0200 |
parents | |
children | 4103f0995bd7 |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:376386a54a3c |
---|---|
1 ;;!emacs | |
2 ;; | |
3 ;; FILE: kotl-mode.el | |
4 ;; SUMMARY: Major mode for editing koutlines and associated commands. | |
5 ;; USAGE: GNU Emacs Lisp Library | |
6 ;; KEYWORDS: data, hypermedia, outlines, wp | |
7 ;; | |
8 ;; AUTHOR: Bob Weiner & Kellie Clark | |
9 ;; | |
10 ;; ORIG-DATE: 6/30/93 | |
11 ;; LAST-MOD: 3-Nov-95 at 19:25:57 by Bob Weiner | |
12 ;; | |
13 ;; This file is part of Hyperbole. | |
14 ;; Available for use and distribution under the same terms as GNU Emacs. | |
15 ;; | |
16 ;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. | |
17 ;; Developed with support from Motorola Inc. | |
18 ;; | |
19 ;; DESCRIPTION: | |
20 ;; DESCRIP-END. | |
21 | |
22 ;;; ************************************************************************ | |
23 ;;; Other required Lisp Libraries | |
24 ;;; ************************************************************************ | |
25 | |
26 (mapcar 'require '(hsite hmail kview kimport kvspec kotl)) | |
27 | |
28 ;;; ************************************************************************ | |
29 ;;; Public variables | |
30 ;;; ************************************************************************ | |
31 | |
32 (defvar kotl-mode:refill-flag nil | |
33 "*Automatically refill cells during move, copy, promotion and demotion operations when non-nil. | |
34 Default value is nil. Cells with a `no-fill' attribute are never refilled | |
35 during such operations, regardless of the value of this flag.") | |
36 | |
37 ;;; ************************************************************************ | |
38 ;;; Public functions | |
39 ;;; ************************************************************************ | |
40 | |
41 ;;;###autoload | |
42 (defun kotl-mode () | |
43 "The major mode used to edit and view koutlines. | |
44 It provides the following keys: | |
45 \\{kotl-mode-map}" | |
46 (interactive) | |
47 (use-local-map kotl-mode-map) | |
48 (set-syntax-table text-mode-syntax-table) | |
49 ;; Turn off filladapt minor mode if on, so that it does not interfere with | |
50 ;; the filling code in "kfill.el". | |
51 (and (boundp 'filladapt-mode) filladapt-mode (filladapt-mode -1)) | |
52 (if (/= 3 (length (action:params (symbol-function 'fill-paragraph)))) | |
53 ;; Some package such as filladapt has overwritten the primitives | |
54 ;; defined in kfill.el, so reload it. | |
55 (load "kfill")) | |
56 ;; Ensure that outline structure data is saved when save-buffer is called | |
57 ;; from save-some-buffers, {C-x s}. | |
58 (add-hook 'local-write-file-hooks 'kotl-mode:update-buffer) | |
59 (mapcar 'make-local-variable | |
60 '(kotl-previous-mode indent-line-function indent-region-function | |
61 minor-mode-alist selective-display-ellipses)) | |
62 ;; Used by kimport.el functions. | |
63 (if (and (boundp 'kotl-previous-mode) kotl-previous-mode) | |
64 nil | |
65 (setq kotl-previous-mode major-mode | |
66 ;; Remove outline indication due to selective-display. | |
67 minor-mode-alist (copy-sequence minor-mode-alist) | |
68 minor-mode-alist (set:remove '(selective-display " Outline") | |
69 minor-mode-alist) | |
70 minor-mode-alist (set:remove '(selective-display " Otl") | |
71 minor-mode-alist) | |
72 ;; Remove indication that buffer is ;; narrowed. | |
73 mode-line-format (copy-sequence mode-line-format) | |
74 mode-line-format (set:remove "%n" mode-line-format))) | |
75 ;; | |
76 (setq indent-line-function 'kotl-mode:indent-line | |
77 indent-region-function 'kotl-mode:indent-region | |
78 local-abbrev-table text-mode-abbrev-table | |
79 selective-display t | |
80 selective-display-ellipses t | |
81 paragraph-start "^[ \t]*$\\|^\^L" | |
82 paragraph-separate "^[ \t]*$\\|^\^L") | |
83 ;; | |
84 ;; This major-mode setting must come after the local variable settings but | |
85 ;; before the koutline is formatted. | |
86 (setq major-mode 'kotl-mode | |
87 mode-name "Kotl" | |
88 indent-tabs-mode nil) | |
89 ;; If buffer has not yet been formatted for editing, format it. | |
90 (cond | |
91 ;; Koutline file that has been loaded and formatted for editing. | |
92 ((kview:is-p kview) | |
93 ;; The buffer might have been widened for inspection, so narrow to cells | |
94 ;; only. | |
95 (kfile:narrow-to-kcells)) | |
96 ;; Koutline file that has been loaded but not yet formatted for editing. | |
97 ((kfile:is-p) | |
98 (kfile:read | |
99 (current-buffer) | |
100 (and buffer-file-name (file-exists-p buffer-file-name))) | |
101 (kvspec:activate)) | |
102 ;; New koutline buffer or a foreign text buffer that must be converted to | |
103 ;; koutline format. | |
104 (t | |
105 (kfile:create (current-buffer)) | |
106 (kvspec:activate))) | |
107 ;; We have been converting a buffer from a foreign format to a koutline. | |
108 ;; Now that it is converted, ensure that kotl-previous-mode is set to | |
109 ;; koutline now. | |
110 (setq kotl-previous-mode 'kotl-mode) | |
111 (run-hooks 'kotl-mode-hook)) | |
112 | |
113 (defun kotl-mode:find-file-hook () | |
114 (if (kview:is-p kview) | |
115 (kotl-mode:to-valid-position)) | |
116 nil) | |
117 | |
118 ;;; Ensure that point ends up at a valid position whenever a find-file | |
119 ;;; is done on a kotl-file. | |
120 (add-hook 'find-file-hooks 'kotl-mode:find-file-hook) | |
121 | |
122 ;;; Ensure that outline structure data is hidden from view after a file save. | |
123 (add-hook 'after-save-hook 'kfile:narrow-to-kcells) | |
124 | |
125 ;;; ------------------------------------------------------------------------ | |
126 ;;; Editing within a single kotl | |
127 ;;; ------------------------------------------------------------------------ | |
128 | |
129 (fset 'kotl-mode:backward-delete-char-untabify | |
130 'kotl-mode:delete-backward-char) | |
131 (fset 'kotl-mode:backward-delete-char | |
132 'kotl-mode:delete-backward-char) | |
133 | |
134 (defun kotl-mode:backward-kill-word (arg) | |
135 "Kill up to prefix ARG words preceding point within a single cell." | |
136 (interactive "*p") | |
137 (or arg (setq arg 1)) | |
138 (cond ((< arg 0) | |
139 (if (kotl-mode:eocp) | |
140 (error "(kotl-mode:backward-kill-word): End of cell"))) | |
141 ((> arg 0) | |
142 (if (kotl-mode:bocp) | |
143 (error "(kotl-mode:backward-kill-word): Beginning of cell")))) | |
144 (if (= arg 0) | |
145 nil | |
146 (save-restriction | |
147 (narrow-to-region (kcell-view:start) (kcell-view:end-contents)) | |
148 (backward-kill-word arg)))) | |
149 | |
150 (defun kotl-mode:center-line () | |
151 "Center the line point is on, within the width specified by `fill-column'. | |
152 This means adjusting the indentation so that it equals the distance between | |
153 the end of the text and `fill-column'." | |
154 (interactive "*") | |
155 (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. | |
156 (let ((indent (kcell-view:indent)) | |
157 (opoint (point-marker)) | |
158 (bocp) | |
159 start) | |
160 (setq start (kotl-mode:beginning-of-line)) | |
161 (if (setq bocp (kotl-mode:bocp)) | |
162 (progn | |
163 ;; Add a temporary fill-prefix since this is the 1st line of the cell | |
164 ;; where label could interfere with centering. | |
165 (insert "\n\n") (insert-char ?\ indent))) | |
166 (center-line) | |
167 (if bocp | |
168 ;; Delete temporary fill prefix. | |
169 (delete-region start (+ start indent 2))) | |
170 (goto-char opoint) | |
171 ;; Move to editable point if need be. | |
172 (kotl-mode:to-valid-position))) | |
173 | |
174 (defun kotl-mode:center-paragraph () | |
175 "Center each nonblank line in the paragraph at or after point. | |
176 See `center-line' for more info." | |
177 (interactive "*") | |
178 (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. | |
179 (let ((indent (kcell-view:indent)) | |
180 (opoint (point-marker)) | |
181 start) | |
182 (backward-paragraph) | |
183 (kotl-mode:to-valid-position) | |
184 (setq start (point)) | |
185 ;; Add a temporary fill-prefix for 1st line in cell which contains a | |
186 ;; label, so is centered properly. | |
187 (insert "\n\n") (insert-char ?\ indent) | |
188 (kcell-view:operate 'center-paragraph) | |
189 ;; Delete temporary fill prefix. | |
190 (delete-region start (+ start indent 2)) | |
191 ;; Return to original point. | |
192 (goto-char (min opoint (kcell-view:end-contents))) | |
193 ;; Move to editable point if need be. | |
194 (kotl-mode:to-valid-position))) | |
195 | |
196 (defun kotl-mode:copy-region-as-kill (start end) | |
197 "Copy region between START and END within a single kcell to kill ring." | |
198 (interactive "r") | |
199 (kotl-mode:kill-region start end t)) | |
200 | |
201 (defun kotl-mode:copy-to-register (register start end &optional delete-flag) | |
202 "Copy into REGISTER the region START to END. | |
203 With optional prefix arg DELETE-FLAG, delete region." | |
204 (interactive "cCopy to register: \nr\nP") | |
205 (let ((indent (kcell-view:indent))) | |
206 (set-register register | |
207 (hypb:replace-match-string | |
208 (concat "^" (make-string indent ?\ )) | |
209 (buffer-substring start end) | |
210 "" t))) | |
211 (if delete-flag (delete-region start end))) | |
212 | |
213 (defun kotl-mode:delete-backward-char (arg &optional kill-flag) | |
214 "Delete up to the preceding prefix ARG characters. | |
215 Return number of characters deleted. | |
216 Optional KILL-FLAG non-nil means save in kill ring instead of deleting. | |
217 Does not delete across cell boundaries." | |
218 (interactive "*P") | |
219 (if (interactive-p) | |
220 (if current-prefix-arg | |
221 (setq kill-flag t | |
222 arg (prefix-numeric-value current-prefix-arg)))) | |
223 (or arg (setq arg 1)) | |
224 (kotl-mode:delete-char (- arg) kill-flag)) | |
225 | |
226 (defun kotl-mode:delete-blank-lines () | |
227 "On blank line within a cell, delete all surrounding blank lines, leaving just one. | |
228 On isolated blank line, delete that one. | |
229 On nonblank line, delete all blank lines that follow it. | |
230 | |
231 If nothing but whitespace follows point until the end of a cell, delete all | |
232 whitespace at the end of the cell." | |
233 (interactive "*") | |
234 ;; If nothing but whitespace from point until the end of cell, remove all | |
235 ;; cell trailing whitespace. | |
236 (let ((end (kcell-view:end-contents)) | |
237 start) | |
238 (if (save-excursion | |
239 (skip-chars-forward " \t\n\r" end) | |
240 (not (kotl-mode:eocp))) | |
241 (kcell-view:operate (function (lambda () (delete-blank-lines)))) | |
242 (setq start (kcell-view:start)) | |
243 (goto-char end) | |
244 ;; delete any preceding whitespace | |
245 (skip-chars-backward " \t\n\r" start) | |
246 (delete-region (max start (point)) end))) | |
247 (kotl-mode:to-valid-position)) | |
248 | |
249 (defun kotl-mode:delete-char (arg &optional kill-flag) | |
250 "Delete up to prefix ARG characters following point. | |
251 Return number of characters deleted. | |
252 Optional KILL-FLAG non-nil means save in kill ring instead of deleting. | |
253 Does not delete across cell boundaries." | |
254 (interactive "*P") | |
255 (if (interactive-p) | |
256 (if current-prefix-arg | |
257 (setq kill-flag t | |
258 arg (prefix-numeric-value current-prefix-arg)))) | |
259 (or arg (setq arg 1)) | |
260 (let ((del-count 0) | |
261 (indent (kcell-view:indent)) | |
262 count start end) | |
263 (cond ((> arg 0) | |
264 (if (kotl-mode:eocp) | |
265 (error "(kotl-mode:delete-char): End of cell") | |
266 (setq end (kcell-view:end) | |
267 arg (min arg (- end (point)))) | |
268 (while (> arg 0) | |
269 (if (kotl-mode:eolp) | |
270 (if (/= ?\ (char-syntax (following-char))) | |
271 (setq arg 0 | |
272 del-count (1- del-count)) | |
273 (delete-char 1 kill-flag) | |
274 ;; There may be non-whitespace characters in the | |
275 ;; indent area. Don't delete them. | |
276 (setq count indent) | |
277 (while (and (> count 0) | |
278 (= ?\ (char-syntax (following-char)))) | |
279 (delete-char 1) | |
280 (setq count (1- count)))) | |
281 (delete-char 1 kill-flag)) | |
282 (setq arg (1- arg) | |
283 del-count (1+ del-count))) | |
284 )) | |
285 ((< arg 0) | |
286 (if (kotl-mode:bocp) | |
287 (error "(kotl-mode:delete-char): Beginning of cell") | |
288 (setq start (kcell-view:start) | |
289 arg (max arg (- start (point)))) | |
290 (while (< arg 0) | |
291 (if (kotl-mode:bolp) | |
292 (if (/= ?\ (char-syntax (preceding-char))) | |
293 (setq arg 0 | |
294 del-count (1- del-count)) | |
295 ;; There may be non-whitespace characters in the | |
296 ;; indent area. Don't delete them. | |
297 (setq count indent) | |
298 (while (and (> count 0) | |
299 (= ?\ (char-syntax (preceding-char)))) | |
300 (delete-char -1) | |
301 (setq count (1- count))) | |
302 (if (zerop count) | |
303 (delete-char -1 kill-flag))) | |
304 (delete-char -1 kill-flag)) | |
305 (setq arg (1+ arg) | |
306 del-count (1+ del-count)))))) | |
307 del-count)) | |
308 | |
309 (defun kotl-mode:delete-horizontal-space () | |
310 "Delete all spaces and tabs around point." | |
311 (interactive "*") | |
312 (save-restriction | |
313 (narrow-to-region | |
314 (save-excursion | |
315 (kotl-mode:start-of-line)) | |
316 (save-excursion | |
317 (kotl-mode:finish-of-line))) | |
318 (delete-horizontal-space))) | |
319 | |
320 (defun kotl-mode:delete-indentation (&optional arg) | |
321 "Join this line to previous and fix up whitespace at join. | |
322 If there is a fill prefix, delete it from the beginning of this line. | |
323 With argument, join this line to following line." | |
324 (interactive "*P") | |
325 (kcell-view:operate | |
326 (function | |
327 (lambda () | |
328 (let ((opoint (point))) | |
329 (beginning-of-line) | |
330 (if arg (forward-line 1)) | |
331 (if (eq (preceding-char) ?\n) | |
332 (progn | |
333 (delete-region (point) (1- (point))) | |
334 ;; If the second line started with the fill prefix, | |
335 ;; delete the prefix. | |
336 (if (and fill-prefix | |
337 (<= (+ (point) (length fill-prefix)) (point-max)) | |
338 (string= fill-prefix | |
339 (buffer-substring | |
340 (point) (+ (point) (length fill-prefix))))) | |
341 (delete-region (point) (+ (point) (length fill-prefix)))) | |
342 (fixup-whitespace)) | |
343 (goto-char opoint))))))) | |
344 | |
345 (defun kotl-mode:fill-cell (&optional justify ignore-collapsed-p) | |
346 "Fill current cell within current view if it does not have a non-nil `no-fill' attribute. | |
347 With optional JUSTIFY, justify cell as well. | |
348 IGNORE-COLLAPSED-P is used when caller has already expanded cell, indicating | |
349 it is not collapsed." | |
350 (interactive "*P") | |
351 (cond ((kcell-view:get-attr 'no-fill) | |
352 (if (interactive-p) | |
353 (progn (beep) | |
354 (message "Current cell has a `do not fill' attribute.") | |
355 nil))) | |
356 ((string-match "\\`[ \t\n\r]*\\'" (kcell-view:contents)) | |
357 ;; Cell content is all whitespace. | |
358 nil) | |
359 (t (let* ((indent (kcell-view:indent)) | |
360 (opoint (set-marker (make-marker) (point))) | |
361 (start (kcell-view:start)) | |
362 (collapsed-p) | |
363 (end (kcell-view:end-contents)) | |
364 temp-prefix prev-point) | |
365 (goto-char start) | |
366 ;; Expand cell if collapsed so that filling is done properly. | |
367 (if (and (not ignore-collapsed-p) | |
368 (setq collapsed-p (search-forward "\r" end t))) | |
369 (subst-char-in-region start end ?\r ?\n t)) | |
370 (goto-char start) | |
371 ;; Add a temporary fill-prefix for first labeled line, so is | |
372 ;; filled properly. | |
373 (insert (setq temp-prefix | |
374 (concat "\n\n" (make-string indent ?\ )))) | |
375 (while (progn (fill-paragraph justify) | |
376 (setq prev-point (point)) | |
377 (forward-paragraph) | |
378 (and (/= (point) prev-point) | |
379 (< (point) (kcell-view:end-contents)) | |
380 (if (memq (preceding-char) '(?\n ?\r)) | |
381 (not (looking-at "[\n\r]")) | |
382 t)))) | |
383 ;; Delete temporary fill prefix. | |
384 (goto-char start) | |
385 (if (looking-at temp-prefix) | |
386 (replace-match "" t t)) | |
387 ;; Return to original point. | |
388 (setq end (kcell-view:end-contents)) | |
389 (goto-char (min opoint end)) | |
390 ;; | |
391 ;; If cell was collapsed before filling, collapse it again. | |
392 (if collapsed-p | |
393 (subst-char-in-region start end ?\n ?\r t)) | |
394 ;; | |
395 ;; Remove markers | |
396 (set-marker opoint nil)) | |
397 ;; Move to editable point if need be. | |
398 (kotl-mode:to-valid-position)))) | |
399 | |
400 (defun kotl-mode:fill-paragraph (&optional justify) | |
401 "Fill the current paragraph within the cell. | |
402 With optional JUSTIFY, justify the paragraph as well. | |
403 Ignore any non-nil no-fill attribute attached to the cell." | |
404 (interactive "*P") | |
405 (let ((indent (kcell-view:indent)) | |
406 (opoint (point-marker)) | |
407 start end) | |
408 (backward-paragraph) | |
409 (kotl-mode:to-valid-position) | |
410 (setq start (point-marker)) | |
411 ;; Add a temporary fill-prefix for 1st line in cell which contains a | |
412 ;; label, so is filled properly. | |
413 (insert "\n\n") (insert-char ?\ indent) | |
414 (setq end (point-marker)) | |
415 ;; Return to original paragraph point. This is the correct formula, | |
416 ;; considering the fill prefix that was just added. | |
417 (goto-char (min (max opoint (point)) (kcell-view:end-contents))) | |
418 (fill-paragraph justify) | |
419 ;; Delete temporary fill prefix. | |
420 (delete-region start end) | |
421 ;; Return to original point. | |
422 (goto-char (min opoint (kcell-view:end-contents))) | |
423 ;; Move to editable point if need be. | |
424 (kotl-mode:to-valid-position) | |
425 ;; Remove markers | |
426 (set-marker opoint nil) | |
427 (set-marker start nil) | |
428 (set-marker end nil))) | |
429 | |
430 ;; XEmacs binds this to {M-q}. | |
431 (fset 'kotl-mode:fill-paragraph-or-region 'kotl-mode:fill-paragraph) | |
432 | |
433 (defun kotl-mode:fill-tree (&optional top-p) | |
434 "Refill each cell within the tree whose root is at point. | |
435 Skip cells with a non-nil no-fill attribute. | |
436 With optional prefix argument TOP-P non-nil, refill all cells in the outline." | |
437 (interactive "P") | |
438 ;; Store list of which cells are presently collapsed. | |
439 (let ((collapsed-cells | |
440 (kview:map-tree | |
441 (function (lambda (view) | |
442 ;; Use free variable label-sep-len bound in | |
443 ;; kview:map-tree for speed. | |
444 (kcell-view:collapsed-p nil label-sep-len))) | |
445 kview top-p))) | |
446 ;; | |
447 ;; Expand all cells in tree. | |
448 (if top-p | |
449 (subst-char-in-region (point-min) (point-max) ?\r ?\n t) | |
450 (save-excursion | |
451 (kotl-mode:end-of-tree) | |
452 (subst-char-in-region | |
453 (point) (kcell-view:end-contents) ?\r ?\n t))) | |
454 ;; | |
455 ;; Refill cells without no-fill property. | |
456 (kview:map-tree (function (lambda (view) (kotl-mode:fill-cell))) | |
457 kview top-p) | |
458 ;; | |
459 ;; Collapse temporarily expanded cells. | |
460 (if (delq nil collapsed-cells) | |
461 (kview:map-tree | |
462 (function | |
463 (lambda (view) | |
464 (if (car collapsed-cells) | |
465 ;; Use free variable label-sep-len bound in | |
466 ;; kview:map-tree for speed. | |
467 (kcell-view:collapse nil label-sep-len)) | |
468 (setq collapsed-cells (cdr collapsed-cells)))) | |
469 kview top-p)))) | |
470 | |
471 (defun kotl-mode:insert-buffer (buffer) | |
472 "Insert after point the contents of BUFFER. | |
473 Puts mark after the inserted text. | |
474 BUFFER may be a buffer or a buffer name." | |
475 (interactive "*bInsert buffer: ") | |
476 (insert-buffer buffer) | |
477 (kotl-mode:add-indent-to-region)) | |
478 | |
479 (defun kotl-mode:insert-file (import-from children-p) | |
480 "Insert each element in IMPORT-FROM as a separate cell in the current view. | |
481 Insert as sibling cells following the current cell unless prefix arg, | |
482 CHILDREN-P is non-nil, then insert as the initial children of the current | |
483 cell. | |
484 | |
485 IMPORT-FROM may be a buffer name or file name (file name completion is | |
486 provided). | |
487 | |
488 See documentation for `kimport:file' for information on how the type of | |
489 importation is determined." | |
490 (interactive | |
491 (list (read-file-name | |
492 (if current-prefix-arg | |
493 "Buffer or file to insert as children of current cell: " | |
494 "Buffer or file to insert as siblings of current cell: ")) | |
495 current-prefix-arg)) | |
496 (kimport:file import-from (current-buffer) children-p)) | |
497 | |
498 (defun kotl-mode:insert-file-contents (filename) | |
499 "Insert contents of file FILENAME into current cell after point. | |
500 Set mark after the inserted text." | |
501 (interactive "*fInsert file: ") | |
502 (let ((tem (insert-file-contents filename))) | |
503 (push-mark (+ (point) (car (cdr tem))))) | |
504 (kotl-mode:add-indent-to-region)) | |
505 | |
506 (defun kotl-mode:insert-register (register &optional arg) | |
507 "Insert contents of register REGISTER at point in current cell. | |
508 REGISTER is a character naming the register to insert. | |
509 Normally puts point before and mark after the inserted text. | |
510 If optional second arg is non-nil, puts mark before and point after. | |
511 Interactively, second arg is non-nil if prefix arg is supplied." | |
512 (interactive "*cInsert register: \nP") | |
513 (push-mark) | |
514 (let ((val (get-register register))) | |
515 (cond ((consp val) | |
516 (insert-rectangle val)) | |
517 ((stringp val) | |
518 (insert val) | |
519 (kotl-mode:add-indent-to-region)) | |
520 ((integerp val) | |
521 (princ val (current-buffer))) | |
522 ((and (markerp val) (marker-position val)) | |
523 (princ (marker-position val) (current-buffer))) | |
524 (t | |
525 (error "Register '%c' does not contain text" register)))) | |
526 (if (not arg) (exchange-point-and-mark))) | |
527 | |
528 (defun kotl-mode:just-one-space () | |
529 "Delete all spaces and tabs around point and leave one space." | |
530 (interactive "*") | |
531 (save-restriction | |
532 (narrow-to-region | |
533 (save-excursion | |
534 (kotl-mode:start-of-line)) | |
535 (save-excursion | |
536 (kotl-mode:finish-of-line))) | |
537 (just-one-space))) | |
538 | |
539 (defun kotl-mode:kill-line (&optional arg) | |
540 "Kill ARG lines from point." | |
541 (interactive "*P") | |
542 (if (and (null arg) | |
543 (kotl-mode:bolp) | |
544 (boundp 'kill-whole-line) kill-whole-line) | |
545 (let ((indent (kcell-view:indent))) | |
546 ;; Kill whole line including newline, if any. | |
547 (kcell-view:operate | |
548 (function | |
549 (lambda () | |
550 (let ((no-newline)) | |
551 (kill-region (point) | |
552 (progn (setq no-newline | |
553 (not (search-forward "\n" nil 'stay))) | |
554 (point))) | |
555 (or no-newline (delete-char indent))))))) | |
556 ;; Kill part of a line or multiple lines. | |
557 (let ((num-arg (prefix-numeric-value arg))) | |
558 (cond | |
559 ((and (null arg) (not (kotl-mode:eolp))) | |
560 ;; kill to eol but not newline | |
561 (kill-region (point) (setq arg (kotl-mode:finish-of-line)))) | |
562 ((= num-arg 0) | |
563 ;; kill to bol | |
564 (kill-region (point) (setq arg (kotl-mode:start-of-line)))) | |
565 (t;; (/= num-arg 0) | |
566 ;; Find start and end of region to kill | |
567 (let ((start (point)) | |
568 (end (min (kcell-view:end-contents) | |
569 (save-excursion (forward-line num-arg) (point))))) | |
570 (kotl-mode:kill-region start end)))))) | |
571 (setq last-command 'kill-region)) | |
572 | |
573 (defun kotl-mode:kill-region (start end &optional copy-p) | |
574 "Kill region between START and END within a single kcell. | |
575 With optional COPY-P equal to 't, copy region to kill ring but does not | |
576 kill it. With COPY-P any other non-nil value, return region as a | |
577 string without affecting kill ring. | |
578 | |
579 If the buffer is read-only and COPY-P is nil, the region will not be deleted | |
580 but it will be copied to the kill ring and then an error will be signaled." | |
581 (interactive "*r") | |
582 (let ((read-only (and (not copy-p) buffer-read-only))) | |
583 (if read-only (setq copy-p t)) | |
584 (if (and (number-or-marker-p start) | |
585 (number-or-marker-p end) | |
586 (eq (kcell-view:cell start) | |
587 (kcell-view:cell end))) | |
588 (save-excursion | |
589 (goto-char start) | |
590 (let ((indent (kcell-view:indent)) | |
591 killed subst-str) | |
592 ;; Convert region to string | |
593 ;; Convert all occurrences of newline + indent | |
594 ;; to just newline, eliminating indent. | |
595 ;; Then save to kill ring. | |
596 (setq subst-str (concat "\\([\n\r]\\)" (make-string indent ?\ )) | |
597 killed | |
598 (hypb:replace-match-string | |
599 subst-str (buffer-substring start end) "\\1")) | |
600 (if copy-p | |
601 nil | |
602 ;; If last char of region is a newline, then delete indent in | |
603 ;; following line. | |
604 (delete-region | |
605 start (+ end (if (memq (char-after (1- (max start end))) | |
606 '(?\n ?\r)) | |
607 indent | |
608 0)))) | |
609 (if (and copy-p (not (eq copy-p t))) | |
610 ;; Return killed region as a string. | |
611 killed | |
612 (if (eq last-command 'kill-region) | |
613 (kill-append killed (< end start)) | |
614 (kill-new killed)) | |
615 (setq this-command 'kill-region) | |
616 (if read-only (barf-if-buffer-read-only)) | |
617 ))) | |
618 (error | |
619 "(kotl-mode:kill-region): Bad region or not within a single kcell.")))) | |
620 | |
621 (fset 'kotl-mode:kill-ring-save 'kotl-mode:copy-region-as-kill) | |
622 | |
623 (defun kotl-mode:kill-sentence (&optional arg) | |
624 "Kill up to prefix ARG (or 1) sentences following point within a single cell." | |
625 (interactive "*p") | |
626 (or arg (setq arg 1)) | |
627 (cond ((> arg 0) | |
628 (if (kotl-mode:eocp) | |
629 (error "(kotl-mode:kill-sentence): End of cell"))) | |
630 ((< arg 0) | |
631 (if (kotl-mode:bocp) | |
632 (error "(kotl-mode:kill-sentence): Beginning of cell")))) | |
633 (if (= arg 0) | |
634 nil | |
635 (kotl-mode:kill-region (point) | |
636 (save-excursion | |
637 (kotl-mode:forward-sentence arg))))) | |
638 | |
639 (defun kotl-mode:kill-word (arg) | |
640 "Kill up to prefix ARG words following point within a single cell." | |
641 (interactive "*p") | |
642 (or arg (setq arg 1)) | |
643 (cond ((> arg 0) | |
644 (if (kotl-mode:eocp) | |
645 (error "(kotl-mode:kill-word): End of cell"))) | |
646 ((< arg 0) | |
647 (if (kotl-mode:bocp) | |
648 (error "(kotl-mode:kill-word): Beginning of cell")))) | |
649 (if (= arg 0) | |
650 nil | |
651 (save-restriction | |
652 (narrow-to-region (kcell-view:start) (kcell-view:end-contents)) | |
653 (kill-word arg)))) | |
654 | |
655 (defun kotl-mode:newline (arg) | |
656 "Insert a newline. With ARG, insert ARG newlines. | |
657 In Auto Fill mode, if no numeric arg, break the preceding line if it is | |
658 too long." | |
659 (interactive "*p") | |
660 (let ((indent (kcell-view:indent))) | |
661 (if (equal arg 1) | |
662 (progn | |
663 (save-excursion | |
664 (insert ?\n) | |
665 (insert-char ?\ indent)) | |
666 (do-auto-fill) | |
667 (forward-line 1) | |
668 (kotl-mode:start-of-line) | |
669 ) | |
670 (while (> arg 0) | |
671 (insert ?\n) | |
672 (insert-char ?\ indent) | |
673 (setq arg (1- arg)))))) | |
674 | |
675 (fset 'kotl-mode:newline-and-indent 'kotl-mode:newline) | |
676 | |
677 (defun kotl-mode:open-line (arg) | |
678 "Insert a newline and leave point before it. | |
679 With arg N, insert N newlines." | |
680 (interactive "*p") | |
681 (let* ((bolp (and (kotl-mode:bolp) (not (kotl-mode:bocp)))) | |
682 (indent (kcell-view:indent))) | |
683 (while (> arg 0) | |
684 (save-excursion | |
685 (insert ?\n) | |
686 (if (and (not bolp) fill-prefix) | |
687 (insert fill-prefix) | |
688 (insert-char ?\ indent))) | |
689 (setq arg (1- arg))) | |
690 (if (and bolp fill-prefix) | |
691 (progn (delete-horizontal-space) | |
692 (insert fill-prefix))) | |
693 )) | |
694 | |
695 (defun kotl-mode:set-fill-prefix (turn-off) | |
696 "Sets fill prefix to line up to point. | |
697 With prefix arg TURN-OFF or at begin of line, turns fill prefix off." | |
698 (interactive "P") | |
699 (set-fill-prefix (or turn-off (kotl-mode:bolp)))) | |
700 | |
701 (defun kotl-mode:transpose-chars (arg) | |
702 "Interchange characters around point, moving forward one character. | |
703 With prefix ARG, take character before point and drag it forward past ARG | |
704 other characters (backward if ARG negative). | |
705 If no prefix ARG and at end of line, the previous two characters are | |
706 exchanged." | |
707 (interactive "*P") | |
708 (and (null arg) (kotl-mode:eolp) (kotl-mode:forward-char -1)) | |
709 (transpose-subr 'kotl-mode:forward-char (prefix-numeric-value arg))) | |
710 | |
711 (defun kotl-mode:transpose-lines (arg) | |
712 "Exchange current line and previous line, leaving point after both. | |
713 If no previous line, exchange current with next line. | |
714 With prefix ARG, take previous line and move it past ARG lines. | |
715 With prefix ARG = 0, interchange the line that contains point with the line | |
716 that contains mark." | |
717 (interactive "*p") | |
718 (cond | |
719 ((and (kotl-mode:first-line-p) (kotl-mode:last-line-p)) | |
720 (error "(kotl-mode:transpose-lines): Only one line in outline")) | |
721 ;; | |
722 ;; Transpose current and previous lines or current and next lines, if no | |
723 ;; previous line. Leave point after both exchanged lines. | |
724 ((= arg 1) | |
725 (let* ((point (point-marker)) | |
726 (mark (set-marker (make-marker) | |
727 (if (kotl-mode:first-line-p) | |
728 (kotl-mode:next-line 1) | |
729 (kotl-mode:previous-line 1))))) | |
730 (kotl-mode:transpose-lines-internal point mark) | |
731 (goto-char (max point mark)) | |
732 (kotl-mode:next-line 1) | |
733 (set-marker mark nil))) | |
734 ;; | |
735 ;; Transpose point and mark lines, leaving point on the line of text that | |
736 ;; originally contained point. | |
737 ((= arg 0) | |
738 (kotl-mode:transpose-lines-internal (point-marker) (hypb:mark-marker t)) | |
739 ;; This is like exchange-point-and-mark, but doesn't activate the | |
740 ;; mark. | |
741 (goto-char (prog1 (hypb:mark t) | |
742 (set-marker (hypb:mark-marker t) (point))))) | |
743 ;; | |
744 ;; Move previous line past ARG next lines and leave point after previous | |
745 ;; line text. | |
746 (t | |
747 (if (kotl-mode:first-line-p) | |
748 (error "(kotl-mode:transpose-lines): No previous line to transpose")) | |
749 (kotl-mode:previous-line 1) | |
750 (let* ((mark (set-marker (make-marker) | |
751 (save-excursion (kotl-mode:next-line arg)))) | |
752 (line-to-move (kotl-mode:delete-line))) | |
753 (condition-case () | |
754 ;; Delete trailing newline if any, ignoring error. | |
755 (kotl-mode:delete-char 1) | |
756 (error nil)) | |
757 (goto-char mark) | |
758 (set-marker mark nil) | |
759 (kotl-mode:finish-of-line) | |
760 (insert "\n") | |
761 (insert-char ?\ (kcell-view:indent)) | |
762 (insert line-to-move) | |
763 (kotl-mode:start-of-line))))) | |
764 | |
765 (defun kotl-mode:transpose-paragraphs (arg) | |
766 "Interchange this (or next) paragraph with previous one." | |
767 (interactive "*p") | |
768 (transpose-subr 'kotl-mode:forward-paragraph (prefix-numeric-value arg))) | |
769 | |
770 (defun kotl-mode:transpose-sentences (arg) | |
771 "Interchange this (next) and previous sentence." | |
772 (interactive "*p") | |
773 (transpose-subr 'kotl-mode:forward-sentence (prefix-numeric-value arg))) | |
774 | |
775 (defun kotl-mode:transpose-words (arg) | |
776 "Interchange words around point, leaving point after both words. | |
777 With prefix ARG, take word before or around point and drag it forward past | |
778 ARG other words (backward if ARG negative). If ARG is zero, the words around | |
779 or after point and around or after mark are interchanged." | |
780 (interactive "*p") | |
781 (transpose-subr 'kotl-mode:forward-word (prefix-numeric-value arg))) | |
782 | |
783 (defun kotl-mode:zap-to-char (arg char) | |
784 "Kill up to and including prefix ARG'th occurrence of CHAR. | |
785 Goes backward if ARG is negative; error if CHAR not found." | |
786 (interactive "*p\ncZap to char within current cell: ") | |
787 (kcell-view:operate | |
788 (function (lambda () (zap-to-char arg char))))) | |
789 | |
790 ;;; ------------------------------------------------------------------------ | |
791 ;;; Editing across kotls | |
792 ;;; ------------------------------------------------------------------------ | |
793 | |
794 (defun kotl-mode:append-cell (contents-cell append-to-cell) | |
795 "Append CONTENTS-CELL to APPEND-TO-CELL. | |
796 APPEND-TO-CELL is refilled if neither cell has a no-fill property and | |
797 kotl-mode:refill-flag is enabled." | |
798 (interactive | |
799 (let* ((label (kcell-view:label)) | |
800 (hargs:defaults (list label label))) | |
801 (hargs:iform-read | |
802 '(interactive | |
803 "*+KAppend contents of cell: \n+KAppend contents of cell <%s> to cell: ")))) | |
804 (save-excursion | |
805 (kotl-mode:goto-cell contents-cell) | |
806 (let ((contents (kcell-view:contents)) | |
807 (no-fill (kcell-view:get-attr 'no-fill))) | |
808 (kotl-mode:goto-cell append-to-cell) | |
809 (if no-fill nil (setq no-fill (kcell-view:get-attr 'no-fill))) | |
810 (goto-char (kcell-view:end-contents)) | |
811 (let ((fill-prefix (make-string (kcell-view:indent) ?\ ))) | |
812 (if (kotl-mode:bolp) | |
813 nil | |
814 ;; Append contents of cell beginning on its own line. | |
815 (insert "\n" fill-prefix)) | |
816 (kview:insert-contents (kcell-view:cell) contents | |
817 (or no-fill (null kotl-mode:refill-flag)) | |
818 fill-prefix))))) | |
819 | |
820 (defun kotl-mode:copy-after (from-cell-ref to-cell-ref child-p) | |
821 "Copy tree rooted at FROM-CELL-REF to follow tree rooted at TO-CELL-REF. | |
822 If prefix arg CHILD-P is non-nil, make FROM-CELL-REF the first child of | |
823 TO-CELL-REF, otherwise make it the sibling following TO-CELL-REF. | |
824 | |
825 Leave point at the start of the root cell of the new tree." | |
826 (interactive | |
827 (let* ((label (kcell-view:label)) | |
828 (hargs:defaults (list label label))) | |
829 (append | |
830 (hargs:iform-read | |
831 (list | |
832 'interactive | |
833 (format "*+KCopy tree: \n+KCopy tree <%%s> to follow as %s of cell: " | |
834 (if current-prefix-arg "child" "sibling")))) | |
835 (list current-prefix-arg)))) | |
836 ;; | |
837 ;; Copy tree in current view and leave point at the start of the copy. | |
838 (goto-char (kotl-mode:move-after from-cell-ref to-cell-ref child-p t)) | |
839 ;; Alter the copied tree so each cell appears to be newly created. | |
840 (kview:map-tree | |
841 (function | |
842 (lambda (view) | |
843 (kcell-view:set-cell | |
844 (kcell:create nil (kview:id-increment view))))) | |
845 kview)) | |
846 | |
847 (defun kotl-mode:copy-before (from-cell-ref to-cell-ref parent-p) | |
848 "Copy tree rooted at FROM-CELL-REF to precede tree rooted at TO-CELL-REF. | |
849 If prefix arg PARENT-P is non-nil, make FROM-CELL-REF the first child of | |
850 TO-CELL-REF's parent, otherwise make it the preceding sibling of TO-CELL-REF. | |
851 | |
852 Leave point at the start of the root cell of the new tree." | |
853 (interactive | |
854 (let* ((label (kcell-view:label)) | |
855 (hargs:defaults (list label label))) | |
856 (append | |
857 (hargs:iform-read | |
858 (list 'interactive | |
859 (format "*+KCopy tree: \n+KCopy tree <%%s> to be %s of cell: " | |
860 (if current-prefix-arg "first child of parent" | |
861 "preceding sibling")))) | |
862 (list current-prefix-arg)))) | |
863 ;; | |
864 ;; Copy tree in current view and leave point at the start of the copy. | |
865 (goto-char (kotl-mode:move-before from-cell-ref to-cell-ref parent-p t)) | |
866 ;; Alter the copied tree so each cell appears to be newly created. | |
867 (kview:map-tree | |
868 (function | |
869 (lambda (view) | |
870 (kcell-view:set-cell | |
871 (kcell:create nil (kview:id-increment view))))) | |
872 kview)) | |
873 | |
874 (defun kotl-mode:copy-to-buffer (cell-ref buffer invisible-flag) | |
875 "Copy outline tree rooted at CELL-REF to a non-koutline BUFFER. | |
876 Invisible text is expanded and included in the copy only if INVISIBLE-FLAG is | |
877 non-nil. The tree is inserted before point in BUFFER. Use \"0\" to copy the | |
878 whole outline buffer." | |
879 (interactive | |
880 (let ((label-default (kcell-view:label))) | |
881 (hargs:iform-read | |
882 '(interactive | |
883 (list | |
884 (hargs:read "Copy tree without attributes: (0 for whole outline) " | |
885 nil label-default nil 'kcell) | |
886 (read-buffer "To buffer: " | |
887 (save-window-excursion | |
888 (if (one-window-p) | |
889 (select-frame (next-frame)) | |
890 (other-window 1)) | |
891 (buffer-name)) | |
892 t) | |
893 (y-or-n-p "Copy invisible text? ")))))) | |
894 (message "") ;; Erase last interactive prompt, if any. | |
895 (setq buffer (get-buffer-create buffer)) | |
896 (if (equal cell-ref "0") | |
897 (hypb:insert-region buffer (point-min) (point-max) invisible-flag) | |
898 (let (start end) | |
899 (save-excursion | |
900 (kotl-mode:goto-cell cell-ref t) | |
901 (save-excursion (beginning-of-line) (setq start (point))) | |
902 (setq end (kotl-mode:tree-end))) | |
903 (hypb:insert-region buffer start end invisible-flag)))) | |
904 | |
905 (defun kotl-mode:move-after (from-cell-ref to-cell-ref child-p | |
906 &optional copy-p fill-p) | |
907 "Move tree rooted at FROM-CELL-REF to follow tree rooted at TO-CELL-REF. | |
908 If prefix arg CHILD-P is non-nil, make FROM-CELL-REF the first child of | |
909 TO-CELL-REF, otherwise make it the sibling following TO-CELL-REF. | |
910 With optional COPY-P, copies tree rather than moving it. | |
911 | |
912 Leave point at original location but return the tree's new start point." | |
913 (interactive | |
914 (let* ((label (kcell-view:label)) | |
915 (hargs:defaults (list label label))) | |
916 (append | |
917 (hargs:iform-read | |
918 (list | |
919 'interactive | |
920 (format "*+KMove tree: \n+KMove tree <%%s> to follow as %s of cell: " | |
921 (if current-prefix-arg "child" "sibling")))) | |
922 (list current-prefix-arg)))) | |
923 (if (and (not copy-p) (equal from-cell-ref to-cell-ref)) | |
924 (error "(kotl-mode:move-after): Can't move tree after itself")) | |
925 (let* ((orig (set-marker (make-marker) (point))) | |
926 (label-sep-len (kview:label-separator-length kview)) | |
927 (move-to-point (set-marker | |
928 (make-marker) | |
929 (kotl-mode:goto-cell to-cell-ref t))) | |
930 (to-label (kcell-view:label)) | |
931 (to-indent (kcell-view:indent nil label-sep-len)) | |
932 (from-label (progn (kotl-mode:goto-cell from-cell-ref t) | |
933 (kcell-view:label))) | |
934 (from-indent (kcell-view:indent nil label-sep-len)) | |
935 (start (kotl-mode:tree-start)) | |
936 (end (kotl-mode:tree-end)) | |
937 (sib-id (if (= 0 (kotl-mode:forward-cell 1)) | |
938 (kcell-view:idstamp))) | |
939 new-tree-start) | |
940 ;; | |
941 ;; We can't move a tree to a point within itself, so if that is the case | |
942 ;; and this is not a copy operation, signal an error. | |
943 (if (and (not copy-p) (>= move-to-point start) (<= move-to-point end)) | |
944 (error "(kotl-mode:move-after): Can't move tree <%s> to within itself" | |
945 from-label)) | |
946 ;; | |
947 ;; If tree to move has a sibling, point is now at the start of the | |
948 ;; sibling cell. Mark its label with a property which will be deleted | |
949 ;; whenever the cell label is renumbered. This tells us whether or not | |
950 ;; to renumber the sibling separately from the tree to move. | |
951 (if sib-id | |
952 ;; Move to middle of label and insert klabel-original temp property. | |
953 (progn (goto-char (- (point) label-sep-len 3)) | |
954 (kproperty:set 'klabel-original t))) | |
955 ;; | |
956 ;; Position for insertion before deletion of tree-to-move from old | |
957 ;; position, in case old position precedes new one. | |
958 ;; Skip past either cell or tree at move-to-point. | |
959 (goto-char move-to-point) | |
960 (if child-p | |
961 ;; Move to insert position for first child of to-cell-ref. | |
962 (progn (goto-char (kcell-view:end)) | |
963 (setq to-label (klabel:child to-label) | |
964 to-indent (+ to-indent (kview:level-indent kview)))) | |
965 ;; Move to after to-cell-ref's tree for insertion as following sibling. | |
966 (goto-char (kotl-mode:tree-end)) | |
967 (setq to-label (klabel:increment to-label))) | |
968 ;; | |
969 ;; Insert tree-to-move at new location | |
970 ;; | |
971 (kview:move start end (point) from-indent to-indent copy-p | |
972 (or fill-p kotl-mode:refill-flag)) | |
973 ;; | |
974 ;; Ensure that point is within editable region of cell with to-label. | |
975 (kotl-mode:to-valid-position) | |
976 (setq new-tree-start (point)) | |
977 ;; | |
978 ;; Update current cell and new siblings' labels within view. | |
979 (klabel-type:update-labels to-label) | |
980 ;; | |
981 (if copy-p | |
982 nil | |
983 ;; | |
984 ;; Move to sibling of tree-to-move within view and update labels within | |
985 ;; view of tree-to-move's original siblings. | |
986 (if sib-id | |
987 (progn (kotl-mode:goto-cell sib-id t) | |
988 ;; Sibling labels may have already been updated if tree was | |
989 ;; moved somewhere preceding its siblings. | |
990 (let ((label-middle (- (point) label-sep-len 2))) | |
991 (if (kproperty:get label-middle 'klabel-original) | |
992 (klabel-type:update-labels from-label)))))) | |
993 ;; | |
994 (goto-char orig) | |
995 ;; | |
996 ;; Ensure that point is within editable region of a cell. | |
997 (kotl-mode:to-valid-position) | |
998 ;; | |
999 (set-marker orig nil) | |
1000 (set-marker move-to-point nil) | |
1001 new-tree-start)) | |
1002 | |
1003 (defun kotl-mode:move-before (from-cell-ref to-cell-ref parent-p | |
1004 &optional copy-p fill-p) | |
1005 "Move tree rooted at FROM-CELL-REF to precede tree rooted at TO-CELL-REF. | |
1006 If prefix arg PARENT-P is non-nil, make FROM-CELL-REF the first child of | |
1007 TO-CELL-REF's parent, otherwise make it the preceding sibling of TO-CELL-REF. | |
1008 With optional COPY-P, copies tree rather than moving it. | |
1009 | |
1010 Leave point at original location but return the tree's new start point." | |
1011 (interactive | |
1012 (let* ((label (kcell-view:label)) | |
1013 (hargs:defaults (list label label))) | |
1014 (append | |
1015 (hargs:iform-read | |
1016 (list 'interactive | |
1017 (format "*+KMove tree: \n+KMove tree <%%s> to be %s of cell: " | |
1018 (if current-prefix-arg "first child of parent" | |
1019 "preceding sibling")))) | |
1020 (list current-prefix-arg)))) | |
1021 (if (and (not copy-p) (equal from-cell-ref to-cell-ref)) | |
1022 (error "(kotl-mode:move-before): Can't move tree before itself")) | |
1023 (let* ((orig (set-marker (make-marker) (point))) | |
1024 (label-sep-len (kview:label-separator-length kview)) | |
1025 (move-to-point (set-marker | |
1026 (make-marker) | |
1027 (kotl-mode:goto-cell to-cell-ref t))) | |
1028 (to-label (kcell-view:label)) | |
1029 (to-indent (kcell-view:indent nil label-sep-len)) | |
1030 (from-label (progn (kotl-mode:goto-cell from-cell-ref t) | |
1031 (kcell-view:label))) | |
1032 (from-indent (kcell-view:indent nil label-sep-len)) | |
1033 (start (kotl-mode:tree-start)) | |
1034 (end (kotl-mode:tree-end)) | |
1035 (sib-id (if (= 0 (kotl-mode:forward-cell 1)) | |
1036 (kcell-view:idstamp))) | |
1037 new-tree-start) | |
1038 ;; | |
1039 ;; We can't move a tree to a point within itself, so if that is the case | |
1040 ;; and this is not a copy operation, signal an error. | |
1041 (if (and (not copy-p) (>= move-to-point start) (<= move-to-point end)) | |
1042 (error "(kotl-mode:move-before): Can't move tree <%s> to within itself" | |
1043 from-label)) | |
1044 ;; | |
1045 ;; If tree to move has a sibling, point is now at the start of the | |
1046 ;; sibling cell. Mark its label with a property which will be deleted | |
1047 ;; whenever the cell label is renumbered. This tells us whether or not | |
1048 ;; to renumber the sibling separately from the tree to move. | |
1049 (if sib-id | |
1050 ;; Move to middle of label and insert klabel-original temp property. | |
1051 (progn (goto-char (- (point) label-sep-len 3)) | |
1052 (kproperty:set 'klabel-original t))) | |
1053 ;; | |
1054 ;; Position for insertion at succeeding-tree, before deletion of | |
1055 ;; tree-to-move from old position, in case old position precedes new one. | |
1056 (goto-char move-to-point) | |
1057 (if parent-p | |
1058 ;; Move to insert position for first child of to-cell-ref's parent. | |
1059 (if (kcell-view:parent nil label-sep-len) | |
1060 (progn (setq to-label (klabel:child (kcell-view:label))) | |
1061 (goto-char (kcell-view:end))) | |
1062 (error "(kotl-mode:move-before): to-cell-ref's parent not in current view")) | |
1063 ;; Move to before to-cell-ref for insertion as preceding sibling. | |
1064 (goto-char (kotl-mode:tree-start))) | |
1065 ;; | |
1066 ;; Insert tree-to-move at new location | |
1067 ;; | |
1068 (kview:move start end (point) from-indent to-indent copy-p | |
1069 (or fill-p kotl-mode:refill-flag)) | |
1070 ;; | |
1071 ;; Ensure that point is within editable region of root of tree just moved. | |
1072 (kotl-mode:to-valid-position) | |
1073 (setq new-tree-start (point)) | |
1074 ;; | |
1075 ;; Update current cell and new siblings' labels within view. | |
1076 (klabel-type:update-labels to-label) | |
1077 ;; | |
1078 (if copy-p | |
1079 nil | |
1080 ;; | |
1081 ;; Move to sibling of tree-to-move within view and update labels within | |
1082 ;; view of tree-to-move's original siblings. | |
1083 (if sib-id | |
1084 (progn | |
1085 (kotl-mode:goto-cell sib-id t) | |
1086 ;; Sibling labels may have already been updated if tree was | |
1087 ;; moved somewhere preceding its siblings. | |
1088 (let ((label-middle (- (point) label-sep-len 2))) | |
1089 (if (kproperty:get label-middle 'klabel-original) | |
1090 (klabel-type:update-labels from-label)))))) | |
1091 ;; | |
1092 (goto-char orig) | |
1093 ;; | |
1094 ;; Ensure that point is within editable region of a cell. | |
1095 (kotl-mode:to-valid-position) | |
1096 ;; | |
1097 (set-marker orig nil) | |
1098 (set-marker move-to-point nil) | |
1099 new-tree-start)) | |
1100 | |
1101 (defun kotl-mode:yank (&optional arg) | |
1102 "Reinsert the last stretch of killed text. | |
1103 More precisely, reinsert the stretch of killed text most recently | |
1104 killed OR yanked. Put point at end, and set mark at beginning. | |
1105 With just C-u as argument, same but put point at beginning (and mark at end). | |
1106 With argument N, reinsert the Nth most recently killed stretch of killed | |
1107 text. | |
1108 See also the command \\[kotl-mode:yank-pop]." | |
1109 (interactive "*P") | |
1110 (push-mark (point)) | |
1111 (let* ((yank-text (current-kill (cond | |
1112 ((listp arg) 0) | |
1113 ((eq arg '-) -1) | |
1114 (t (1- arg))))) | |
1115 (indent (kcell-view:indent)) | |
1116 (indent-str (make-string indent ?\ ))) | |
1117 ;; Convert all occurrences of newline to newline + cell indent. | |
1118 ;; Then insert into buffer. | |
1119 (insert (hypb:replace-match-string | |
1120 "[\n\r]" yank-text (concat "\\0" indent-str)))) | |
1121 (if (consp arg) | |
1122 ;; This is like exchange-point-and-mark, but doesn't activate the mark. | |
1123 ;; It is cleaner to avoid activation, even though the command | |
1124 ;; loop would deactivate the mark because we inserted text. | |
1125 (goto-char (prog1 (mark t) | |
1126 (set-marker (hypb:mark-marker t) (point))))) | |
1127 nil) | |
1128 | |
1129 (defun kotl-mode:yank-pop (arg) | |
1130 "Replace just-yanked stretch of killed text with a different stretch. | |
1131 This command is allowed only immediately after a `yank' or a `yank-pop'. | |
1132 At such a time, the region contains a stretch of reinserted | |
1133 previously-killed text. `yank-pop' deletes that text and inserts in its | |
1134 place a different stretch of killed text. | |
1135 | |
1136 With no argument, the previous kill is inserted. | |
1137 With argument N, insert the Nth previous kill. | |
1138 If N is negative, this is a more recent kill. | |
1139 | |
1140 The sequence of kills wraps around, so that after the oldest one | |
1141 comes the newest one." | |
1142 (interactive "*p") | |
1143 (if (not (eq last-command 'kotl-mode:yank)) | |
1144 (error "Previous command was not a yank")) | |
1145 (setq this-command 'kotl-mode:yank) | |
1146 (let ((before (< (point) (mark t)))) | |
1147 (delete-region (point) (mark t)) | |
1148 (set-marker (hypb:mark-marker t) (point) (current-buffer)) | |
1149 (let* ((yank-text (current-kill arg)) | |
1150 (indent (kcell-view:indent)) | |
1151 (indent-str (make-string indent ?\ ))) | |
1152 ;; Convert all occurrences of newline to newline + cell indent. | |
1153 ;; Then insert into buffer. | |
1154 (insert (hypb:replace-match-string | |
1155 "[\n\r]" yank-text (concat "\\0" indent-str)))) | |
1156 (if before | |
1157 ;; This is like exchange-point-and-mark, but doesn't activate the mark. | |
1158 ;; It is cleaner to avoid activation, even though the command | |
1159 ;; loop would deactivate the mark because we inserted text. | |
1160 (goto-char (prog1 (mark t) | |
1161 (set-marker (hypb:mark-marker t) (point) (current-buffer)))))) | |
1162 nil) | |
1163 | |
1164 ;;; ------------------------------------------------------------------------ | |
1165 ;;; Movement | |
1166 ;;; ------------------------------------------------------------------------ | |
1167 | |
1168 ;;; Cursor and keypad key functions aliases for XEmacs. | |
1169 (if (not (string-match "XEmacs\\|Lucid" emacs-version)) | |
1170 nil | |
1171 (fset 'kotl-mode:fkey-backward-char 'kotl-mode:backward-char) | |
1172 (fset 'kotl-mode:fkey-forward-char 'kotl-mode:forward-char) | |
1173 (fset 'kotl-mode:fkey-next-line 'kotl-mode:next-line) | |
1174 (fset 'kotl-mode:fkey-previous-line 'kotl-mode:previous-line) | |
1175 (fset 'kotl-mode:deprecated-scroll-down 'kotl-mode:scroll-down) | |
1176 (fset 'kotl-mode:deprecated-scroll-up 'kotl-mode:scroll-up) | |
1177 (fset 'kotl-mode:deprecated-bob 'kotl-mode:beginning-of-buffer) | |
1178 (fset 'kotl-mode:deprecated-eob 'kotl-mode:end-of-buffer)) | |
1179 | |
1180 (defun kotl-mode:back-to-indentation () | |
1181 "Move point to the first non-read-only non-whitespace character on this line." | |
1182 (interactive) | |
1183 (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. | |
1184 (back-to-indentation) | |
1185 (kotl-mode:to-valid-position)) | |
1186 | |
1187 (defun kotl-mode:backward-cell (arg) | |
1188 "Move to prefix ARGth prior visible cell (same level) within current view. | |
1189 Return number of cells left to move." | |
1190 (interactive "p") | |
1191 (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. | |
1192 (if (< arg 0) | |
1193 (kotl-mode:forward-cell (- arg)) | |
1194 (let ((prior (= arg 0)) | |
1195 (label-sep-len (kview:label-separator-length kview))) | |
1196 (while (and (> arg 0) (setq prior (kcell-view:backward t label-sep-len))) | |
1197 (setq arg (1- arg))) | |
1198 (if (or prior (not (interactive-p))) | |
1199 arg | |
1200 (error "(kotl-mode:backward-cell): No prior cell at same level"))))) | |
1201 | |
1202 (defun kotl-mode:backward-char (&optional arg) | |
1203 "Move point backward ARG (or 1) characters and return point." | |
1204 (interactive "p") | |
1205 (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. | |
1206 (or arg (setq arg 1)) | |
1207 (if (>= arg 0) | |
1208 (while (> arg 0) | |
1209 (cond ((kotl-mode:bobp) | |
1210 (error "(kotl-mode:backward-char): Beginning of buffer")) | |
1211 ((kotl-mode:bocp) | |
1212 (if (kcell-view:previous) | |
1213 (kotl-mode:end-of-cell))) | |
1214 ((kotl-mode:bolp) | |
1215 (if (re-search-backward "[\n\r]" nil t) | |
1216 (kotl-mode:to-valid-position t))) | |
1217 (t (backward-char))) | |
1218 (setq arg (1- arg))) | |
1219 (kotl-mode:forward-char (- arg))) | |
1220 (point)) | |
1221 | |
1222 (defun kotl-mode:backward-paragraph (&optional arg) | |
1223 "Move backward to start of paragraph. | |
1224 With arg N, do it N times; negative arg -N means move forward N paragraphs. | |
1225 Return point. | |
1226 | |
1227 A paragraph start is the beginning of a line which is a | |
1228 `first-line-of-paragraph' or which is ordinary text and follows a | |
1229 paragraph-separating line. | |
1230 | |
1231 See `forward-paragraph' for more information." | |
1232 (interactive "p") | |
1233 (setq arg (prefix-numeric-value arg) | |
1234 zmacs-region-stays t);; Maintain region highlight for XEmacs. | |
1235 (kotl-mode:forward-paragraph (- arg))) | |
1236 | |
1237 (fset 'kotl-mode:backward-para 'kotl-mode:backward-paragraph) | |
1238 | |
1239 (defun kotl-mode:backward-sentence (&optional arg) | |
1240 "Move point backward ARG (or 1) sentences and return point." | |
1241 (interactive "p") | |
1242 (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. | |
1243 (let* ((label-sep-len (kview:label-separator-length kview)) | |
1244 ;; Setting fill prefix makes sentence commands properly recognize | |
1245 ;; indented paragraphs. | |
1246 (fill-prefix (make-string (kcell-view:indent nil label-sep-len) ?\ ))) | |
1247 (if (kotl-mode:bobp) | |
1248 (error "(kotl-mode:backward-sentence): First sentence") | |
1249 (if (and (kotl-mode:bocp) (kcell-view:previous nil label-sep-len)) | |
1250 (goto-char (kcell-view:end-contents))) | |
1251 (or arg (setq arg 1)) | |
1252 (save-restriction | |
1253 (if (= arg 1) | |
1254 (narrow-to-region | |
1255 (- (kcell-view:start nil label-sep-len) | |
1256 (kcell-view:indent nil label-sep-len)) | |
1257 (kcell-view:end-contents))) | |
1258 (unwind-protect | |
1259 (let ((opoint (point))) | |
1260 (backward-sentence arg) | |
1261 (if (= opoint (point)) | |
1262 (progn (kcell-view:previous nil label-sep-len) | |
1263 (backward-sentence arg)))) | |
1264 (kotl-mode:to-valid-position t))))) | |
1265 (point)) | |
1266 | |
1267 (defun kotl-mode:backward-word (&optional arg) | |
1268 "Move point backward ARG (or 1) words and return point." | |
1269 (interactive "p") | |
1270 (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. | |
1271 (or arg (setq arg 1)) | |
1272 (if (>= arg 0) | |
1273 (while (> arg 0) | |
1274 (cond ((kotl-mode:bobp) (setq arg 0)) | |
1275 ((kotl-mode:bocp) | |
1276 (beginning-of-line) | |
1277 (kotl-mode:to-valid-position t))) | |
1278 (unwind-protect | |
1279 (backward-word 1) | |
1280 (kotl-mode:to-valid-position t)) | |
1281 (setq arg (1- arg))) | |
1282 (kotl-mode:forward-word (- arg))) | |
1283 (point)) | |
1284 | |
1285 (defun kotl-mode:beginning-of-buffer () | |
1286 "Move point to beginning of buffer and return point." | |
1287 (interactive) | |
1288 (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. | |
1289 (goto-char (point-min)) | |
1290 ;; To move to cell start. | |
1291 (goto-char (kcell-view:start))) | |
1292 | |
1293 (defun kotl-mode:beginning-of-cell (&optional arg) | |
1294 "Move point to beginning of current or ARGth - 1 prior cell and return point." | |
1295 (interactive "p") | |
1296 (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. | |
1297 (or arg (setq arg 1)) | |
1298 (or (integer-or-marker-p arg) | |
1299 (error "(kotl-mode:beginning-of-cell): Wrong type arg, integer-or-marker, '%s'" arg)) | |
1300 (if (= arg 1) | |
1301 (goto-char (kcell-view:start)) | |
1302 (kotl-mode:backward-cell (1- arg))) | |
1303 (point)) | |
1304 | |
1305 ;;; Avoid XEmacs byte-compiler bug which inserts nil for calls to this | |
1306 ;;; function if named kotl-mode:beginning-of-line. | |
1307 ;;; | |
1308 (defun kotl-mode:start-of-line (&optional arg) | |
1309 "Move point to beginning of current or ARGth - 1 line and return point." | |
1310 (interactive "p") | |
1311 (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. | |
1312 (or arg (setq arg 1)) | |
1313 (or (integer-or-marker-p arg) | |
1314 (error "(kotl-mode:start-of-line): Wrong type arg, integer-or-marker, '%s'" arg)) | |
1315 (forward-line (1- arg)) | |
1316 (if (eolp) | |
1317 nil | |
1318 (forward-char (prog1 (kcell-view:indent) | |
1319 (beginning-of-line)))) | |
1320 (point)) | |
1321 | |
1322 (defalias 'kotl-mode:beginning-of-line 'kotl-mode:start-of-line) | |
1323 | |
1324 (defun kotl-mode:beginning-of-tree () | |
1325 "Move point to the level 1 root of the current cell's tree. | |
1326 Leave point at the start of the cell." | |
1327 (interactive) | |
1328 (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. | |
1329 (let ((label-sep-len (kview:label-separator-length kview))) | |
1330 (if (/= (kcell-view:level nil label-sep-len) 1) | |
1331 ;; Enable user to return to this previous position if desired. | |
1332 (push-mark nil 'no-msg)) | |
1333 (while (and (/= (kcell-view:level nil label-sep-len) 1) | |
1334 (kcell-view:parent nil label-sep-len))) | |
1335 (kotl-mode:beginning-of-cell))) | |
1336 | |
1337 (defun kotl-mode:down-level (arg) | |
1338 "Move down prefix ARG levels lower within current tree." | |
1339 (interactive "p") | |
1340 (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. | |
1341 (if (< arg 0) | |
1342 (kotl-mode:up-level (- arg)) | |
1343 ;; Enable user to return to this previous position if desired. | |
1344 (push-mark nil 'no-msg) | |
1345 (let ((child)) | |
1346 (while (and (> arg 0) (kcell-view:child)) | |
1347 (or child (setq child t)) | |
1348 (setq arg (1- arg))) | |
1349 ;; Signal an error if couldn't move down at least 1 child level. | |
1350 (or child | |
1351 (progn | |
1352 (goto-char (hypb:mark t)) | |
1353 (pop-mark) | |
1354 (error "(kotl-mode:down-level): No child level to which to move") | |
1355 ))))) | |
1356 | |
1357 (defun kotl-mode:end-of-buffer () | |
1358 "Move point to end of buffer and return point." | |
1359 (interactive) | |
1360 (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. | |
1361 (goto-char (point-max)) | |
1362 ;; To move to cell end. | |
1363 (kotl-mode:to-valid-position t) | |
1364 (point)) | |
1365 | |
1366 (defun kotl-mode:end-of-cell (&optional arg) | |
1367 "Move point to end of current or ARGth - 1 succeeding cell and return point." | |
1368 (interactive "p") | |
1369 (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. | |
1370 (or arg (setq arg 1)) | |
1371 (or (integer-or-marker-p arg) | |
1372 (error "(kotl-mode:end-of-cell): Wrong type arg, integer-or-marker, '%s'" arg)) | |
1373 (if (= arg 1) | |
1374 (goto-char (kcell-view:end-contents)) | |
1375 (kotl-mode:forward-cell (1- arg))) | |
1376 (point)) | |
1377 | |
1378 ;;; Avoid XEmacs byte-compiler bug which inserts nil for calls to this | |
1379 ;;; function if named kotl-mode:end-of-line. | |
1380 ;;; | |
1381 (defun kotl-mode:finish-of-line (&optional arg) | |
1382 "Move point to end of current or ARGth - 1 line and return point." | |
1383 (interactive "p") | |
1384 (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. | |
1385 (or arg (setq arg 1)) | |
1386 (or (integer-or-marker-p arg) | |
1387 (error "(kotl-mode:finish-of-line): Wrong type arg, integer-or-marker, '%s'" arg)) | |
1388 (forward-line (1- arg)) | |
1389 (end-of-line) | |
1390 ;; May have to move backwards to before label if support labels | |
1391 ;; at end of cells. | |
1392 (point)) | |
1393 | |
1394 (defalias 'kotl-mode:end-of-line 'kotl-mode:finish-of-line) | |
1395 | |
1396 (defun kotl-mode:end-of-tree () | |
1397 "Move point to the last cell in tree rooted at the current cell. | |
1398 Leave point at the start of the cell." | |
1399 (interactive) | |
1400 (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. | |
1401 ;; Enable user to return to this previous position if desired. | |
1402 (push-mark nil 'no-msg) | |
1403 (let ((label-sep-len (kview:label-separator-length kview))) | |
1404 (if (kcell-view:forward nil label-sep-len) | |
1405 ;; Move to cell preceding start of next tree. | |
1406 (kcell-view:previous nil label-sep-len) | |
1407 ;; Otherwise, no next tree, so move until find last cell in tree. | |
1408 (let ((cell-indent (kcell-view:indent nil label-sep-len)) | |
1409 (end-point (point))) | |
1410 ;; Terminate when no further cells or when reach a cell at an equal | |
1411 ;; or higher level in the outline than the first cell that we | |
1412 ;; processed. | |
1413 (while (and (kcell-view:next nil label-sep-len) | |
1414 (> (kcell-view:indent nil label-sep-len) cell-indent)) | |
1415 (setq end-point (point))) | |
1416 (goto-char end-point))) | |
1417 (kotl-mode:beginning-of-cell))) | |
1418 | |
1419 (defun kotl-mode:first-sibling () | |
1420 "Move point to the first sibling of the present cell. | |
1421 Leave point at the start of the cell or at its present position if it is | |
1422 already within the first sibling cell." | |
1423 (interactive) | |
1424 (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. | |
1425 (let ((label-sep-len (kview:label-separator-length kview))) | |
1426 (if (save-excursion (kcell-view:backward nil label-sep-len)) | |
1427 ;; Enable user to return to this previous position if desired. | |
1428 (push-mark nil 'no-msg)) | |
1429 (while (kcell-view:backward nil label-sep-len)))) | |
1430 | |
1431 (defun kotl-mode:forward-cell (arg) | |
1432 "Move to prefix ARGth following cell (same level) within current view. | |
1433 Return number of cells left to move." | |
1434 (interactive "p") | |
1435 (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. | |
1436 (if (< arg 0) | |
1437 (kotl-mode:backward-cell (- arg)) | |
1438 (let ((next (= arg 0)) | |
1439 (label-sep-len (kview:label-separator-length kview))) | |
1440 (while (and (> arg 0) (setq next (kcell-view:forward t label-sep-len))) | |
1441 (setq arg (1- arg))) | |
1442 (if (or next (not (interactive-p))) | |
1443 arg | |
1444 (error "(kotl-mode:forward-cell): No following cell at same level"))))) | |
1445 | |
1446 (defun kotl-mode:forward-char (&optional arg) | |
1447 "Move point forward ARG (or 1) characters and return point." | |
1448 (interactive "p") | |
1449 (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. | |
1450 (or arg (setq arg 1)) | |
1451 (if (>= arg 0) | |
1452 (while (> arg 0) | |
1453 (cond ((and (kotl-mode:eolp) (kotl-mode:last-line-p)) | |
1454 (error "(kotl-mode:forward-char): End of buffer")) | |
1455 ((kotl-mode:eocp) | |
1456 (skip-chars-forward "\n\r") | |
1457 (kotl-mode:start-of-line)) | |
1458 ((kotl-mode:eolp) | |
1459 (forward-char) | |
1460 (kotl-mode:start-of-line)) | |
1461 (t (forward-char))) | |
1462 (setq arg (1- arg))) | |
1463 (kotl-mode:backward-char (- arg))) | |
1464 (point)) | |
1465 | |
1466 (defun kotl-mode:forward-paragraph (&optional arg) | |
1467 "Move point forward until after the last character of the current paragraph. | |
1468 With arg N, do it N times; negative arg -N means move backward N paragraphs. | |
1469 Return point. | |
1470 | |
1471 A line which `paragraph-start' matches either separates paragraphs | |
1472 \(if `paragraph-separate' matches it also) or is the first line of a paragraph. | |
1473 A paragraph end is one character before the beginning of a line which is not | |
1474 part of the paragraph, or the end of the buffer." | |
1475 (interactive "p") | |
1476 (setq arg (prefix-numeric-value arg) | |
1477 zmacs-region-stays t);; Maintain region highlight for XEmacs. | |
1478 (if (< arg 0) | |
1479 (progn | |
1480 (if (kotl-mode:bocp) (setq arg (1- arg))) | |
1481 (while (< arg 0) | |
1482 (start-of-paragraph-text) | |
1483 (setq arg (1+ arg)))) | |
1484 (while (> arg 0) | |
1485 (end-of-paragraph-text) | |
1486 (setq arg (1- arg)))) | |
1487 (kotl-mode:to-valid-position) | |
1488 (point)) | |
1489 | |
1490 (fset 'kotl-mode:forward-para 'kotl-mode:forward-paragraph) | |
1491 | |
1492 (defun kotl-mode:forward-sentence (&optional arg) | |
1493 "Move point forward ARG (or 1) sentences and return point." | |
1494 (interactive "P") | |
1495 (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. | |
1496 (let* ((label-sep-len (kview:label-separator-length kview)) | |
1497 ;; Setting fill prefix makes sentence commands properly recognize | |
1498 ;; indented paragraphs. | |
1499 (fill-prefix (make-string (kcell-view:indent nil label-sep-len) ?\ ))) | |
1500 (if (kotl-mode:eobp) | |
1501 (error "(kotl-mode:forward-sentence): Last sentence") | |
1502 (if (kotl-mode:eocp) (kcell-view:next nil label-sep-len)) | |
1503 (or arg (setq arg 1)) | |
1504 (save-restriction | |
1505 (if (= arg 1) | |
1506 (narrow-to-region | |
1507 (- (kcell-view:start nil label-sep-len) | |
1508 (kcell-view:indent nil label-sep-len)) | |
1509 (kcell-view:end-contents))) | |
1510 (unwind-protect | |
1511 (let ((opoint (point))) | |
1512 (forward-sentence arg) | |
1513 (if (= opoint (point)) | |
1514 (progn (kcell-view:next nil label-sep-len) | |
1515 (forward-sentence arg)))) | |
1516 (kotl-mode:to-valid-position))))) | |
1517 (point)) | |
1518 | |
1519 (defun kotl-mode:forward-word (&optional arg) | |
1520 "Move point forward ARG (or 1) words and return point." | |
1521 (interactive "p") | |
1522 (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. | |
1523 (or arg (setq arg 1)) | |
1524 (if (>= arg 0) | |
1525 (while (> arg 0) | |
1526 (cond ((kotl-mode:eobp) (setq arg 0)) | |
1527 ((kotl-mode:eocp) | |
1528 (skip-chars-forward "\n\r") | |
1529 (kotl-mode:start-of-line))) | |
1530 (unwind-protect | |
1531 (forward-word 1) | |
1532 (kotl-mode:to-valid-position)) | |
1533 ;; If point is at beginning of a cell after moving forward a word, | |
1534 ;; then we moved over something other than a word (some | |
1535 ;; punctuation or an outline autonumber); therefore, leave counter as | |
1536 ;; is in order to move forward over next word. | |
1537 (or (kotl-mode:bocp) | |
1538 (setq arg (1- arg)))) | |
1539 (kotl-mode:backward-word (- arg))) | |
1540 (point)) | |
1541 | |
1542 (defun kotl-mode:goto-cell (cell-ref &optional error-p) | |
1543 "Move point to start of cell given by CELL-REF. (See 'kcell:ref-to-id'.) | |
1544 Return point iff CELL-REF is found within current view. | |
1545 With a prefix argument, CELL-REF is assigned the argument value for use | |
1546 as an idstamp. | |
1547 | |
1548 Optional second arg, ERROR-P, non-nil means signal an error if CELL-REF is | |
1549 not found within current view. Will signal same error if called | |
1550 interactively when CELL-REF is not found." | |
1551 (interactive | |
1552 (list (if current-prefix-arg | |
1553 (format "0%d" (prefix-numeric-value current-prefix-arg)) | |
1554 (read-string "Goto cell label or id: ")))) | |
1555 (setq cell-ref | |
1556 (or (kcell:ref-to-id cell-ref) | |
1557 (error "(kotl-mode:goto-cell): Invalid cell reference, '%s'" cell-ref))) | |
1558 (let* ((opoint (point)) | |
1559 (found) | |
1560 cell-id kvspec) | |
1561 (if (= ?| (aref cell-ref 0)) | |
1562 ;; This is a standalone view spec, not a cell reference. | |
1563 (progn (kvspec:activate cell-ref) (setq found (point))) | |
1564 | |
1565 ;; !! Remove any relative specs and view specs from | |
1566 ;; cell-ref to form cell-id. Really should account for relative | |
1567 ;; specs here, but we don't yet support them. | |
1568 (if (string-match "\\(\\.[a-zA-Z]+\\)?\\([|:].*\\)\\|\\.[a-zA-Z]+" | |
1569 cell-ref) | |
1570 (setq cell-id (substring cell-ref 0 (match-beginning 0)) | |
1571 kvspec (if (match-beginning 2) | |
1572 (substring | |
1573 cell-ref (match-beginning 2) (match-end 2)))) | |
1574 (setq cell-id cell-ref kvspec nil)) | |
1575 | |
1576 (goto-char (point-min)) | |
1577 (cond ((= ?0 (aref cell-id 0)) | |
1578 ;; is an idstamp | |
1579 (if (kview:goto-cell-id cell-id) | |
1580 (setq found (point)))) | |
1581 ;; is a label | |
1582 ((re-search-forward | |
1583 (format "\\([\n\r][\n\r]\\|\\`\\)[ ]*%s%s" | |
1584 (regexp-quote cell-id) | |
1585 (regexp-quote (kview:label-separator kview))) | |
1586 nil t) | |
1587 (setq found (point))) | |
1588 ;; no match | |
1589 (t (goto-char opoint) | |
1590 nil)) | |
1591 (if (and (not found) (or error-p (interactive-p))) | |
1592 (error "(kotl-mode:goto-cell): No '%s' cell in this view" cell-ref) | |
1593 ;; Activate any viewspec associated with cell-ref. | |
1594 (if kvspec (kvspec:activate kvspec)))) | |
1595 found)) | |
1596 | |
1597 (defun kotl-mode:head-cell () | |
1598 "Move point to the start of the first visible cell at the same level as current cell. | |
1599 If at head cell already, do nothing and return nil." | |
1600 (interactive "p") | |
1601 (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. | |
1602 (let ((moved) | |
1603 (label-sep-len (kview:label-separator-length kview))) | |
1604 (while (kcell-view:backward t label-sep-len) | |
1605 (setq moved t)) | |
1606 moved)) | |
1607 | |
1608 (defun kotl-mode:last-sibling () | |
1609 "Move point to the last sibling of the present cell. | |
1610 Leave point at the start of the cell or at its present position if it is | |
1611 already within the last sibling cell." | |
1612 (interactive) | |
1613 (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. | |
1614 (let ((label-sep-len (kview:label-separator-length kview))) | |
1615 (if (save-excursion (kcell-view:forward nil label-sep-len)) | |
1616 ;; Enable user to return to this previous position if desired. | |
1617 (push-mark nil 'no-msg)) | |
1618 (while (kcell-view:forward nil label-sep-len)))) | |
1619 | |
1620 (defun kotl-mode:mark-paragraph () | |
1621 "Put point at beginning of this paragraph, mark at end. | |
1622 The paragraph marked is the one that contains point or follows point." | |
1623 (interactive) | |
1624 (forward-paragraph 1) | |
1625 (kotl-mode:to-valid-position t) | |
1626 (hypb:push-mark nil t t) | |
1627 (backward-paragraph 1) | |
1628 (kotl-mode:to-valid-position)) | |
1629 | |
1630 (defun kotl-mode:mark-whole-buffer () | |
1631 "Put point at first editable character in buffer and mark at the last such character." | |
1632 (interactive) | |
1633 (hypb:push-mark (point)) | |
1634 (kotl-mode:end-of-buffer) | |
1635 (hypb:push-mark (point) nil t) | |
1636 (kotl-mode:beginning-of-buffer)) | |
1637 | |
1638 (defun kotl-mode:next-cell (arg) | |
1639 "Move to prefix ARGth next cell (any level) within current view." | |
1640 (interactive "p") | |
1641 (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. | |
1642 (if (< arg 0) | |
1643 (kotl-mode:previous-cell (- arg)) | |
1644 (let ((next (= arg 0)) | |
1645 (label-sep-len (kview:label-separator-length kview))) | |
1646 (while (and (> arg 0) (setq next (kcell-view:next t label-sep-len))) | |
1647 (setq arg (1- arg))) | |
1648 (if next | |
1649 arg | |
1650 (error "(kotl-mode:next-cell): Last cell"))))) | |
1651 | |
1652 (defun kotl-mode:next-line (arg) | |
1653 "Move point to ARGth next line and return point." | |
1654 (interactive "p") | |
1655 (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. | |
1656 (kotl-mode:set-temp-goal-column) | |
1657 (let ((orig-arg arg)) | |
1658 (cond ((> arg 0) | |
1659 (while (and (> arg 0) (= 0 (forward-line 1))) | |
1660 (cond ((kotl-mode:eobp) | |
1661 (forward-line -1) | |
1662 (goto-char (kcell-view:end-contents)) | |
1663 (and (interactive-p) (= orig-arg arg) | |
1664 (message "(kotl-mode:next-line): Last line") (beep)) | |
1665 (setq arg 0) | |
1666 ) | |
1667 ((looking-at "^$");; blank line between cells | |
1668 nil);; Don't count this line. | |
1669 (t (setq arg (1- arg))))) | |
1670 (kotl-mode:line-move 0) | |
1671 (kotl-mode:to-valid-position) | |
1672 ) | |
1673 ((< arg 0) | |
1674 (kotl-mode:previous-line (- arg))) | |
1675 (t))) | |
1676 (setq this-command 'next-line) | |
1677 (point)) | |
1678 | |
1679 (defun kotl-mode:next-tree () | |
1680 "Move past current tree to next tree, or to last cell in tree if no next tree. | |
1681 Return non-nil iff there is a next tree within this koutline." | |
1682 (let ((start-indent (kcell-view:indent)) | |
1683 (label-sep-len (kview:label-separator-length kview)) | |
1684 (same-tree t)) | |
1685 (while (and (kcell-view:next nil label-sep-len) | |
1686 (setq same-tree (< start-indent | |
1687 (kcell-view:indent nil label-sep-len))))) | |
1688 (not same-tree))) | |
1689 | |
1690 (defun kotl-mode:previous-line (arg) | |
1691 "Move point to ARGth previous line and return point." | |
1692 (interactive "p") | |
1693 (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. | |
1694 (kotl-mode:set-temp-goal-column) | |
1695 (cond ((> arg 0) | |
1696 (while (and (> arg 0) (= 0 (forward-line -1))) | |
1697 (cond ((kotl-mode:bobp) | |
1698 (kotl-mode:beginning-of-cell) | |
1699 (setq arg 0)) | |
1700 ((looking-at "^$") ;; blank line between cells | |
1701 nil) ;; Don't count this line. | |
1702 (t (setq arg (1- arg))))) | |
1703 (kotl-mode:line-move 0) | |
1704 (kotl-mode:to-valid-position) | |
1705 ) | |
1706 ((< arg 0) | |
1707 (kotl-mode:next-line (- arg))) | |
1708 (t)) | |
1709 (setq this-command 'previous-line) | |
1710 (point)) | |
1711 | |
1712 (defun kotl-mode:previous-cell (arg) | |
1713 "Move to prefix ARGth previous cell (any level) within current view." | |
1714 (interactive "p") | |
1715 (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. | |
1716 (if (< arg 0) | |
1717 (kotl-mode:next-cell (- arg)) | |
1718 (let ((previous (= arg 0)) | |
1719 (label-sep-len (kview:label-separator-length kview))) | |
1720 (while (and (> arg 0) (setq previous | |
1721 (kcell-view:previous t label-sep-len))) | |
1722 (setq arg (1- arg))) | |
1723 (if previous | |
1724 arg | |
1725 (error "(kotl-mode:previous-cell): First cell"))))) | |
1726 | |
1727 (defun kotl-mode:scroll-down (arg) | |
1728 "Scroll text of current window downward ARG lines; or a windowful if no ARG." | |
1729 (interactive "P") | |
1730 (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. | |
1731 (scroll-down arg) | |
1732 (kotl-mode:to-valid-position t)) | |
1733 | |
1734 (defun kotl-mode:scroll-up (arg) | |
1735 "Scroll text of current window upward ARG lines; or a windowful if no ARG." | |
1736 (interactive "P") | |
1737 (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. | |
1738 (scroll-up arg) | |
1739 (kotl-mode:to-valid-position)) | |
1740 | |
1741 (defun kotl-mode:tail-cell () | |
1742 "Move point to the start of the last visible cell at the same level as current cell and return t. | |
1743 If at tail cell already, do nothing and return nil." | |
1744 (interactive "p") | |
1745 (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. | |
1746 (let ((moved) | |
1747 (label-sep-len (kview:label-separator-length kview))) | |
1748 (while (kcell-view:forward t label-sep-len) | |
1749 (setq moved t)) | |
1750 moved)) | |
1751 | |
1752 (defun kotl-mode:up-level (arg) | |
1753 "Move up prefix ARG levels higher in current outline view." | |
1754 (interactive "p") | |
1755 (setq zmacs-region-stays t) ;; Maintain region highlight for XEmacs. | |
1756 (if (< arg 0) | |
1757 (kotl-mode:down-level (- arg)) | |
1758 ;; Enable user to return to this previous position if desired. | |
1759 (push-mark nil 'no-msg) | |
1760 (let ((parent) | |
1761 (label-sep-len (kview:label-separator-length kview)) | |
1762 result) | |
1763 (while (and (> arg 0) (setq result (kcell-view:parent t label-sep-len))) | |
1764 (or parent (setq parent result)) | |
1765 (setq arg (if (eq result 0) 0 (1- arg)))) | |
1766 ;; Signal an error if couldn't move up at least 1 parent level. | |
1767 (or (and parent (not (eq parent 0))) | |
1768 (progn | |
1769 (goto-char (hypb:mark t)) | |
1770 (pop-mark) | |
1771 (error "(kotl-mode:up-level): No parent level to which to move") | |
1772 ))))) | |
1773 | |
1774 ;;; ------------------------------------------------------------------------ | |
1775 ;;; Predicates | |
1776 ;;; ------------------------------------------------------------------------ | |
1777 | |
1778 (defun kotl-mode:bobp () | |
1779 "Return point if at the start of the first cell in kview, else nil." | |
1780 (interactive) | |
1781 (or (bobp) | |
1782 (and (not (save-excursion (re-search-backward "[\n\r]" nil t))) | |
1783 (kotl-mode:bolp)))) | |
1784 | |
1785 (defun kotl-mode:bocp () | |
1786 "Return point if at beginning of a kcell, else nil." | |
1787 (and (kotl-mode:bolp) | |
1788 (let ((begin-point (kcell-view:plist-point)) | |
1789 (bol)) | |
1790 (and begin-point | |
1791 (save-excursion | |
1792 ;; If first line-begin is less than cell begin point, | |
1793 ;; then we know we are on the first line of the cell. | |
1794 (if (setq bol (re-search-backward "^" nil t)) | |
1795 (<= bol begin-point))))) | |
1796 (point))) | |
1797 | |
1798 (defun kotl-mode:bolp () | |
1799 "Return point if at beginning of a kview line, else nil." | |
1800 (if (= (current-column) (kcell-view:indent)) | |
1801 (point))) | |
1802 | |
1803 (defun kotl-mode:buffer-empty-p () | |
1804 "Return non-nil iff there are no outline cells within current buffer." | |
1805 (save-excursion | |
1806 (goto-char (point-min)) | |
1807 (looking-at "[\n\r]*\\'"))) | |
1808 | |
1809 (defun kotl-mode:eobp () | |
1810 "Return point if after the end of the last cell in kview, else nil." | |
1811 (interactive) | |
1812 (if (looking-at "^[\n\r]*\\'") (point))) | |
1813 | |
1814 (defun kotl-mode:eocp () | |
1815 "Return point if at the end of a kview cell, else nil." | |
1816 (or (eobp) | |
1817 (looking-at "[\n\r]+\\'") | |
1818 (and (eolp) | |
1819 (save-excursion | |
1820 (skip-chars-forward "\n\r") | |
1821 (kotl-mode:start-of-line) | |
1822 (kotl-mode:bocp))))) | |
1823 | |
1824 (fset 'kotl-mode:eolp 'eolp) | |
1825 | |
1826 (defun kotl-mode:first-cell-p () | |
1827 "Return t iff point is on the first cell of the outline." | |
1828 (save-excursion (not (kcell-view:previous)))) | |
1829 | |
1830 (fset 'kotl-mode:first-line-p 'first-line-p) | |
1831 | |
1832 (defun kotl-mode:last-cell-p () | |
1833 "Return t iff point is on the last cell of the outline." | |
1834 (save-excursion (not (kcell-view:next)))) | |
1835 | |
1836 (defun kotl-mode:last-line-p () | |
1837 "Return t iff point is on the last line of the outline." | |
1838 (save-excursion | |
1839 (kotl-mode:finish-of-line) | |
1840 (looking-at "\n*\\'"))) | |
1841 | |
1842 ;;; ------------------------------------------------------------------------ | |
1843 ;;; Smart Key Support | |
1844 ;;; ------------------------------------------------------------------------ | |
1845 | |
1846 | |
1847 (defun kotl-mode:action-key () | |
1848 "Collapses, expands, links to, and scrolls through koutline cells. | |
1849 Invoked via a key press when in kotl-mode. It assumes that its caller has | |
1850 already checked that the key was pressed in an appropriate buffer and has | |
1851 moved the cursor to the selected buffer. | |
1852 | |
1853 If key is pressed: | |
1854 (1) at the end of buffer, uncollapse and unhide all cells in view; | |
1855 (2) within a cell, if its subtree is hidden then show it, | |
1856 otherwise hide it; | |
1857 (3) between cells or within the read-only indentation region to the left of | |
1858 a cell, then move point to prior location and begin creation of a | |
1859 klink to some other outline cell; hit the Action Key twice to select the | |
1860 link referent cell; | |
1861 (4) anywhere else, scroll up a windowful." | |
1862 (interactive) | |
1863 (cond ((kotl-mode:eobp) (kotl-mode:show-all)) | |
1864 ((kotl-mode:eolp) (smart-scroll-up)) | |
1865 ((not (kview:valid-position-p)) | |
1866 (if (markerp action-key-depress-prev-point) | |
1867 (progn (select-window | |
1868 (get-buffer-window | |
1869 (marker-buffer action-key-depress-prev-point))) | |
1870 (goto-char (marker-position action-key-depress-prev-point)) | |
1871 (call-interactively 'klink:create)) | |
1872 (kotl-mode:to-valid-position) | |
1873 (error "(kotl-mode:action-key): Action Key released at invalid position"))) | |
1874 (t ;; On a cell line (not at the end of line). | |
1875 (if (smart-outline-subtree-hidden-p) | |
1876 (kotl-mode:show-tree (kcell-view:label)) | |
1877 (kotl-mode:hide-tree (kcell-view:label))))) | |
1878 (kotl-mode:to-valid-position)) | |
1879 | |
1880 (defun kotl-mode:help-key () | |
1881 "Displays properties of koutline cells, collapses all cells, and scrolls back. | |
1882 Invoked via an assist-key press when in kotl-mode. It assumes that its caller | |
1883 has already checked that the assist-key was pressed in an appropriate buffer | |
1884 and has moved the cursor to the selected buffer. | |
1885 | |
1886 If assist-key is pressed: | |
1887 (1) at the end of buffer, collapse all cells and hide all non-level-one | |
1888 cells; | |
1889 (2) on a header line but not at the beginning or end, display properties of | |
1890 each cell in tree beginning at point; | |
1891 (3) between cells or within the read-only indentation region to the left of | |
1892 a cell, then move point to prior location and prompt to move one tree to | |
1893 a new location in the outline; hit the Action Key twice to select the | |
1894 tree to move and where to move it; | |
1895 (4) anywhere else, scroll down a windowful." | |
1896 (interactive) | |
1897 (cond ((kotl-mode:eobp) (kotl-mode:overview)) | |
1898 ((kotl-mode:eolp) (smart-scroll-down)) | |
1899 ((not (kview:valid-position-p)) | |
1900 (if (markerp assist-key-depress-prev-point) | |
1901 (progn (select-window | |
1902 (get-buffer-window | |
1903 (marker-buffer assist-key-depress-prev-point))) | |
1904 (goto-char (marker-position | |
1905 assist-key-depress-prev-point)) | |
1906 (call-interactively 'kotl-mode:move-after)) | |
1907 (kotl-mode:to-valid-position) | |
1908 (error "(kotl-mode:help-key): Help Key released at invalid position"))) | |
1909 ((not (bolp)) | |
1910 ;; On an outline header line but not at the start/end of line, | |
1911 ;; show attributes for tree at point. | |
1912 (kotl-mode:cell-help (kcell-view:label) (or current-prefix-arg 2))) | |
1913 ((smart-scroll-down))) | |
1914 (kotl-mode:to-valid-position)) | |
1915 | |
1916 ;;; ------------------------------------------------------------------------ | |
1917 ;;; Structure Editing | |
1918 ;;; ------------------------------------------------------------------------ | |
1919 | |
1920 (defun kotl-mode:add-child () | |
1921 "Add a new cell to current kview as first child of current cell." | |
1922 (interactive "*") | |
1923 (kotl-mode:add-cell '(4))) | |
1924 | |
1925 (defun kotl-mode:add-parent () | |
1926 "Add a new cell to current kview as sibling of current cell's parent." | |
1927 (interactive "*") | |
1928 (kotl-mode:add-cell -1)) | |
1929 | |
1930 (defun kotl-mode:add-cell (&optional relative-level contents plist no-fill) | |
1931 "Add a cell following current cell at optional RELATIVE-LEVEL with CONTENTS string, attributes in PLIST, a property list, and NO-FILL flag to prevent any filling of CONTENTS. | |
1932 | |
1933 Optional prefix arg RELATIVE-LEVEL means add as sibling if nil or >= 0, as | |
1934 child if equal to universal argument, {C-u}, and as sibling of current cell's | |
1935 parent, otherwise. If added as sibling of current level, RELATIVE-LEVEL is | |
1936 used as a repeat count for the number of cells to add. | |
1937 | |
1938 Return last newly added cell." | |
1939 (interactive "*P") | |
1940 (or (stringp contents) (setq contents nil)) | |
1941 (let ((klabel (kcell-view:label)) | |
1942 (label-sep-len (kview:label-separator-length kview)) | |
1943 cell-level new-cell sibling-p child-p start parent | |
1944 cells-to-add) | |
1945 (setq cell-level (kcell-view:level nil label-sep-len) | |
1946 child-p (equal relative-level '(4)) | |
1947 sibling-p (and (not child-p) | |
1948 (cond ((not relative-level) 1) | |
1949 ((>= (prefix-numeric-value relative-level) 0) | |
1950 (prefix-numeric-value relative-level)))) | |
1951 cells-to-add (or sibling-p 1)) | |
1952 (if child-p | |
1953 (setq cell-level (1+ cell-level)) | |
1954 (if sibling-p | |
1955 nil | |
1956 ;; Add as following sibling of current cell's parent. | |
1957 ;; Move to parent. | |
1958 (setq cell-level (1- cell-level) | |
1959 start (point) | |
1960 parent (kcell-view:parent nil label-sep-len)) | |
1961 (if (not (eq parent t)) | |
1962 (progn | |
1963 (goto-char start) | |
1964 (error | |
1965 "(kotl-mode:add-cell): No higher level at which to add cell.") | |
1966 ))) | |
1967 ;; Skip from point past any children to next cell. | |
1968 (if (kotl-mode:next-tree) | |
1969 ;; If found a new tree, then move back to prior cell so can add | |
1970 ;; new cell after it. | |
1971 (kcell-view:previous nil label-sep-len))) | |
1972 (goto-char (kcell-view:end)) | |
1973 ;; | |
1974 ;; Insert new cells into view. | |
1975 (if (= cells-to-add 1) | |
1976 (setq klabel | |
1977 (cond (sibling-p | |
1978 (klabel:increment klabel)) | |
1979 (child-p (klabel:child klabel)) | |
1980 ;; add as sibling of parent of current cell | |
1981 (t (klabel:increment (klabel:parent klabel)))) | |
1982 new-cell (kview:add-cell klabel cell-level contents plist | |
1983 (or no-fill sibling-p | |
1984 (not kotl-mode:refill-flag)))) | |
1985 ;; | |
1986 ;; sibling-p must be true if we are looping here so there is no need to | |
1987 ;; conditionalize how to increment the labels. | |
1988 (while (>= (setq cells-to-add (1- cells-to-add)) 0) | |
1989 (setq klabel (klabel:increment klabel) | |
1990 ;; Since new cells are at the same level as old one, don't fill | |
1991 ;; any of their intial contents. | |
1992 new-cell (kview:add-cell klabel cell-level contents plist t)))) | |
1993 ;; | |
1994 ;; Move back to last inserted cell and then move to its following | |
1995 ;; sibling if any. | |
1996 (kotl-mode:to-valid-position t) | |
1997 (save-excursion | |
1998 (if (kcell-view:forward t label-sep-len) | |
1999 ;; Update the labels of these siblings and their subtrees. | |
2000 (klabel-type:update-labels (klabel:increment klabel)))) | |
2001 ;; | |
2002 ;; Leave point within last newly added cell and return this cell. | |
2003 (kotl-mode:beginning-of-cell) | |
2004 new-cell)) | |
2005 | |
2006 (defun kotl-mode:demote-tree (arg) | |
2007 "Move current tree a maximum of prefix ARG levels lower in current view. | |
2008 Each cell is refilled iff its `no-fill' attribute is nil and | |
2009 kotl-mode:refill-flag is non-nil. With prefix ARG = 0, cells are demoted up | |
2010 to one level and kotl-mode:refill-flag is treated as true." | |
2011 (interactive "*p") | |
2012 (if (< arg 0) | |
2013 (kotl-mode:promote-tree (- arg)) | |
2014 (let* ((label-sep-len (kview:label-separator-length kview)) | |
2015 (orig-level (kcell-view:level nil label-sep-len)) | |
2016 (orig-point (point)) | |
2017 (orig-id (kcell-view:idstamp)) | |
2018 (fill-p (= arg 0)) | |
2019 (orig-pos-in-cell | |
2020 (- (point) (kcell-view:start nil label-sep-len))) | |
2021 prev prev-level) | |
2022 (if fill-p (setq arg 1)) | |
2023 (unwind-protect | |
2024 (progn | |
2025 (backward-char 1) | |
2026 (while (and (> arg 0) | |
2027 (setq prev | |
2028 (kcell-view:previous nil label-sep-len))) | |
2029 (if prev | |
2030 (progn (setq prev-level | |
2031 (kcell-view:level nil label-sep-len)) | |
2032 (cond ((> prev-level (+ orig-level arg)) | |
2033 ;; Don't want to demote this far | |
2034 ;; so keep looking at prior nodes. | |
2035 nil) | |
2036 ((= arg (- prev-level orig-level)) | |
2037 ;; Demote to be sibling of this kcell. | |
2038 (setq arg -1)) | |
2039 ((< prev-level orig-level) | |
2040 ;; prev is at higher level then | |
2041 ;; orig, so can't demote | |
2042 (setq prev nil | |
2043 arg 0)) | |
2044 (t | |
2045 ;; Demote below this kcell. This is | |
2046 ;; as far we can demote, though it may | |
2047 ;; not be the full amount of arg. | |
2048 (setq arg 0)))))) | |
2049 (if prev | |
2050 (kotl-mode:move-after | |
2051 (kcell-view:label orig-point) | |
2052 (kcell-view:label) (= arg 0) | |
2053 nil fill-p))) | |
2054 ;; Move to start of original cell | |
2055 (kotl-mode:goto-cell orig-id) | |
2056 ;; Move to original pos within cell | |
2057 (forward-char orig-pos-in-cell) | |
2058 (kotl-mode:to-valid-position)) | |
2059 (if (not prev) | |
2060 (error "(kotl-mode:demote-tree): Cannot demote any further"))))) | |
2061 | |
2062 (defun kotl-mode:exchange-cells (cell-ref-1 cell-ref-2) | |
2063 "Exchange CELL-REF-1 with CELL-REF-2 in current view. Don't move point." | |
2064 (interactive | |
2065 (let ((hargs:defaults | |
2066 (save-excursion | |
2067 (list (kcell-view:label) | |
2068 (cond | |
2069 ((kcell-view:previous t) | |
2070 (kcell-view:label)) | |
2071 ((kcell-view:next t) | |
2072 (kcell-view:label)) | |
2073 (t (error | |
2074 "(kotl-mode:exchange-cells): No 2 visible cells"))))))) | |
2075 (hargs:iform-read | |
2076 '(interactive "*+KExchange cell: \n+KExchange cell <%s> with cell: ")))) | |
2077 (save-excursion | |
2078 (let (kcell-1 contents-1 | |
2079 kcell-2 contents-2) | |
2080 ;; | |
2081 ;; Save cell-1 attributes | |
2082 (kotl-mode:goto-cell cell-ref-1 t) | |
2083 (setq kcell-1 (kcell-view:cell) | |
2084 contents-1 (kcell-view:contents)) | |
2085 ;; | |
2086 ;; Save cell-2 attributes | |
2087 (kotl-mode:goto-cell cell-ref-2 t) | |
2088 (setq kcell-2 (kcell-view:cell) | |
2089 contents-2 (kcell-view:contents)) | |
2090 ;; | |
2091 ;; Substitute cell-1 attributes into cell-2 location. | |
2092 ;; | |
2093 ;; Set kcell properties. | |
2094 (kcell-view:set-cell kcell-1) | |
2095 ;; If idstamp labels are on, then must exchange labels in view. | |
2096 (if (eq (kview:label-type kview) 'id) | |
2097 (klabel:set (kcell-view:idstamp))) | |
2098 ;; Exchange cell contents. | |
2099 (delete-region (kcell-view:start) (kcell-view:end-contents)) | |
2100 (insert | |
2101 (hypb:replace-match-string | |
2102 "\\([\n\r]\\)" | |
2103 contents-1 (concat "\\1" (make-string (kcell-view:indent) ?\ )))) | |
2104 (if kotl-mode:refill-flag (kotl-mode:fill-cell)) | |
2105 ;; | |
2106 ;; Substitute cell-2 attributes into cell-1 location. | |
2107 ;; | |
2108 ;; Set kcell properties. | |
2109 (kotl-mode:goto-cell cell-ref-1 t) | |
2110 (kcell-view:set-cell kcell-2) | |
2111 ;; If idstamp labels are on, then must exchange labels in view. | |
2112 (if (eq (kview:label-type kview) 'id) | |
2113 (klabel:set (kcell-view:idstamp))) | |
2114 ;; Exchange cell contents. | |
2115 (delete-region (kcell-view:start) (kcell-view:end-contents)) | |
2116 ;; Add indentation to all but first line. | |
2117 (insert | |
2118 (hypb:replace-match-string | |
2119 "\\([\n\r]\\)" | |
2120 contents-2 (concat "\\1" (make-string (kcell-view:indent) ?\ )))) | |
2121 (if kotl-mode:refill-flag (kotl-mode:fill-cell))))) | |
2122 | |
2123 (defun kotl-mode:kill-contents (arg) | |
2124 "Kill contents of cell from point to cell end. | |
2125 With prefix ARG, kill entire cell contents." | |
2126 (interactive "*P") | |
2127 (kotl-mode:kill-region | |
2128 (if arg (kcell-view:start) (point)) | |
2129 (kcell-view:end-contents))) | |
2130 | |
2131 (defun kotl-mode:kill-tree (&optional arg) | |
2132 "Kill ARG following trees starting with tree rooted at point. | |
2133 If ARG is not a non-positive number, nothing is done." | |
2134 (interactive "*p") | |
2135 (or (integerp arg) (setq arg 1)) | |
2136 (let ((killed) (label (kcell-view:label)) | |
2137 (label-sep-len (kview:label-separator-length kview)) | |
2138 start end sib) | |
2139 (while (> arg 0) | |
2140 (setq start (kotl-mode:tree-start) | |
2141 end (kotl-mode:tree-end) | |
2142 sib (kcell-view:sibling-p nil nil label-sep-len) | |
2143 arg (1- arg) | |
2144 killed t) | |
2145 ;; Don't want to delete any prior cells, so if on last cell, ensure | |
2146 ;; this is the last one killed. | |
2147 (if (kotl-mode:last-cell-p) | |
2148 (progn (setq arg 0) | |
2149 (kview:delete-region start end)) | |
2150 (kview:delete-region start end) | |
2151 (kotl-mode:to-valid-position))) | |
2152 (if killed | |
2153 (progn | |
2154 (cond (sib (klabel-type:update-labels label)) | |
2155 ((kotl-mode:buffer-empty-p) | |
2156 ;; Always leave at least 1 visible cell within a view. | |
2157 (kview:add-cell "1" 1))) | |
2158 (kotl-mode:to-valid-position))))) | |
2159 | |
2160 (defun kotl-mode:mail-tree (cell-ref invisible-flag) | |
2161 "Mail outline tree rooted at CELL-REF. Use \"0\" for whole outline buffer. | |
2162 Invisible text is expanded and included in the mail only if INVISIBLE-FLAG is | |
2163 non-nil." | |
2164 (interactive | |
2165 (let ((label-default (kcell-view:label))) | |
2166 (hargs:iform-read | |
2167 '(interactive | |
2168 (list | |
2169 (hargs:read "Mail tree: (0 for whole outline) " | |
2170 nil label-default nil 'kcell) | |
2171 (y-or-n-p "Include invisible text? ")))))) | |
2172 (if (equal cell-ref "0") | |
2173 (hmail:buffer nil invisible-flag) | |
2174 (let (start end) | |
2175 (save-excursion | |
2176 (kotl-mode:goto-cell cell-ref t) | |
2177 (beginning-of-line) | |
2178 (setq start (point)) | |
2179 (or (= (kotl-mode:forward-cell 1) 0) (goto-char (point-max))) | |
2180 (forward-line -1) | |
2181 (setq end (point))) | |
2182 (hmail:region start end nil invisible-flag)))) | |
2183 | |
2184 (defun kotl-mode:promote-tree (arg) | |
2185 "Move current tree a maximum of prefix ARG levels higher in current view. | |
2186 Each cell is refilled iff its `no-fill' attribute is nil and | |
2187 kotl-mode:refill-flag is non-nil. With prefix ARG = 0, cells are promoted up | |
2188 to one level and kotl-mode:refill-flag is treated as true." | |
2189 (interactive "*p") | |
2190 (if (< arg 0) | |
2191 (kotl-mode:demote-tree (- arg)) | |
2192 (let* ((parent) (result) | |
2193 (label-sep-len (kview:label-separator-length kview)) | |
2194 (orig-point (point)) | |
2195 (orig-id (kcell-view:idstamp)) | |
2196 (fill-p (= arg 0)) | |
2197 (orig-pos-in-cell | |
2198 (- (point) (kcell-view:start nil label-sep-len)))) | |
2199 (if fill-p (setq arg 1)) | |
2200 (unwind-protect | |
2201 (progn | |
2202 (backward-char 1) | |
2203 (while (and (> arg 0) | |
2204 (setq result (kcell-view:parent | |
2205 nil label-sep-len)) | |
2206 (not (eq result 0))) | |
2207 (setq parent result | |
2208 arg (1- arg))) | |
2209 (if parent | |
2210 (kotl-mode:move-after | |
2211 (kcell-view:label orig-point) | |
2212 (kcell-view:label) nil | |
2213 nil fill-p))) | |
2214 ;; Move to start of original cell | |
2215 (kotl-mode:goto-cell orig-id) | |
2216 ;; Move to original pos within cell | |
2217 (forward-char orig-pos-in-cell) | |
2218 (kotl-mode:to-valid-position)) | |
2219 (if (not parent) | |
2220 (error "(kotl-mode:promote-tree): Cannot promote any further"))))) | |
2221 | |
2222 (defun kotl-mode:set-cell-attribute (attribute value &optional pos) | |
2223 "Include ATTRIBUTE VALUE with the current cell or the cell at optional POS. | |
2224 Replaces any existing value that ATTRIBUTE has. | |
2225 When called interactively, it displays the setting in the minibuffer as | |
2226 confirmation." | |
2227 (interactive | |
2228 (let* ((plist (copy-sequence (kcell-view:plist))) | |
2229 (existing-attributes plist) | |
2230 attribute value) | |
2231 (barf-if-buffer-read-only) | |
2232 ;; Remove attribute values | |
2233 (while plist | |
2234 (setcdr plist (cdr (cdr plist))) | |
2235 (setq plist (cdr plist))) | |
2236 ;; Remove read-only attributes | |
2237 (setq existing-attributes (set:create existing-attributes) | |
2238 existing-attributes (set:difference | |
2239 existing-attributes | |
2240 kcell:read-only-attributes)) | |
2241 | |
2242 (while (zerop (length (setq attribute | |
2243 (completing-read | |
2244 "Current cell attribute to set: " | |
2245 (mapcar 'list | |
2246 (mapcar 'symbol-name | |
2247 existing-attributes)))))) | |
2248 (beep)) | |
2249 (setq attribute (intern attribute) | |
2250 value (kcell-view:get-attr attribute)) | |
2251 (if value | |
2252 (setq value (read-expression | |
2253 (format "Change value of \"%s\" to: " attribute) | |
2254 (prin1-to-string value))) | |
2255 (setq value (read-expression | |
2256 (format "Set value of \"%s\" to: " attribute)))) | |
2257 (list attribute value nil))) | |
2258 (kcell-view:set-attr attribute value pos) | |
2259 ;; Note that buffer needs to be saved to store new attribute value. | |
2260 (set-buffer-modified-p t) | |
2261 (if (interactive-p) | |
2262 (message "Attribute \"%s\" set to `%s' in cell <%s>." | |
2263 attribute value (kcell-view:label pos)))) | |
2264 | |
2265 (defun kotl-mode:split-cell (&optional arg) | |
2266 "Split the current cell into two cells and move to the new cell. | |
2267 The cell contents after point become part of the newly created cell. | |
2268 The default is to create the new cell as a sibling of the current cell. | |
2269 With optional universal ARG, {C-u}, the new cell is added as the child of | |
2270 the current cell." | |
2271 (interactive "*P") | |
2272 (let ((new-cell-contents (kotl-mode:kill-region | |
2273 (point) (kcell-view:end-contents) 'string)) | |
2274 (start (kcell-view:start))) | |
2275 ;; delete any preceding whitespace | |
2276 (skip-chars-backward " \t\n\r" start) | |
2277 (delete-region (max start (point)) (kcell-view:end-contents)) | |
2278 (kotl-mode:add-cell arg new-cell-contents (kcell-view:plist)))) | |
2279 | |
2280 (defun kotl-mode:transpose-cells (arg) | |
2281 "Exchange current and previous visible cells, leaving point after both. | |
2282 If no previous cell, exchange current with next cell. | |
2283 With prefix ARG, take current tree and move it past ARG visible cells. | |
2284 With prefix ARG = 0, interchange the cell that contains point with the cell | |
2285 that contains mark." | |
2286 (interactive "*p") | |
2287 (let ((label-sep-len (kview:label-separator-length kview))) | |
2288 (cond | |
2289 ((save-excursion (not (or (kcell-view:next t label-sep-len) | |
2290 (kcell-view:previous t label-sep-len)))) | |
2291 (error "(kotl-mode:transpose-cells): Only one visible cell in outline")) | |
2292 ;; | |
2293 ;; Transpose current and previous cells or current and next cells, if no | |
2294 ;; previous cell. Leave point after both exchanged cells or within last | |
2295 ;; visible cell. | |
2296 ((= arg 1) | |
2297 (let ((label-1 (kcell-view:label)) | |
2298 (prev (kcell-view:previous t label-sep-len)) | |
2299 label-2) | |
2300 (or prev (kcell-view:next t label-sep-len)) | |
2301 (setq label-2 (kcell-view:label)) | |
2302 (kotl-mode:exchange-cells label-1 label-2) | |
2303 (kcell-view:next t label-sep-len) | |
2304 (if prev (kcell-view:next t label-sep-len)))) | |
2305 ;; | |
2306 ;; Transpose point and mark cells, moving point to the new location of the | |
2307 ;; cell which originally contained point. | |
2308 ((= arg 0) | |
2309 (let ((label-1 (kcell-view:label)) | |
2310 label-2) | |
2311 ;; This is like exchange-point-and-mark, but doesn't activate the | |
2312 ;; mark. | |
2313 (goto-char (prog1 (hypb:mark t) | |
2314 (set-marker (hypb:mark-marker t) (point)))) | |
2315 (setq label-2 (kcell-view:label)) | |
2316 (kotl-mode:exchange-cells label-1 label-2))) | |
2317 ;; | |
2318 ;; Move current tree past ARG next visible cells and leave point after | |
2319 ;; original cell text. | |
2320 (t | |
2321 (let ((mark (set-marker (make-marker) | |
2322 (save-excursion (kotl-mode:next-line arg))))) | |
2323 (kotl-mode:move-after | |
2324 (kcell-view:label) | |
2325 (progn (while (and (> arg 0) (kcell-view:next t label-sep-len)) | |
2326 (setq arg (1- arg))) | |
2327 (kcell-view:label)) | |
2328 nil) | |
2329 (goto-char mark) | |
2330 (set-marker mark nil)))))) | |
2331 | |
2332 ;;; ------------------------------------------------------------------------ | |
2333 ;;; Structure Viewing | |
2334 ;;; ------------------------------------------------------------------------ | |
2335 | |
2336 (defun kotl-mode:collapse-tree (&optional all-flag) | |
2337 "Collapse to one line each visible cell of tree rooted at point. | |
2338 With optional ALL-FLAG non-nil, collapse all cells visible within the current | |
2339 view." | |
2340 (interactive "P") | |
2341 (kotl-mode:is-p) | |
2342 (let (buffer-read-only) | |
2343 (if all-flag | |
2344 (progn (kvspec:show-lines-per-cell 1) | |
2345 (kvspec:update t)) | |
2346 (kview:map-tree | |
2347 (function | |
2348 (lambda (kview) | |
2349 ;; Use free variable label-sep-len bound in kview:map-tree for speed. | |
2350 (goto-char (kcell-view:start nil label-sep-len)) | |
2351 (subst-char-in-region (point) (kcell-view:end-contents) ?\n ?\r t))) | |
2352 kview nil t)))) | |
2353 | |
2354 (defun kotl-mode:expand-tree (&optional all-flag) | |
2355 "Expand each visible cell of tree rooted at point. | |
2356 With optional ALL-FLAG non-nil, expand all cells visible within the current | |
2357 view." | |
2358 (interactive "P") | |
2359 (kotl-mode:is-p) | |
2360 (let (buffer-read-only) | |
2361 (if all-flag | |
2362 (progn (kvspec:show-lines-per-cell 0) | |
2363 (kvspec:update t)) | |
2364 (kview:map-tree | |
2365 (function | |
2366 (lambda (kview) | |
2367 ;; Use free variable label-sep-len bound in kview:map-tree for speed. | |
2368 (goto-char (kcell-view:start nil label-sep-len)) | |
2369 (subst-char-in-region (point) (kcell-view:end-contents) ?\r ?\n t))) | |
2370 kview nil t)))) | |
2371 | |
2372 (defun kotl-mode:toggle-tree-expansion (&optional all-flag) | |
2373 "Collapse or expand each cell of tree rooted at point or all visible cells if optional prefix arg ALL-FLAG is given. | |
2374 If current cell is collapsed, cells will be expanded, otherwise they will be | |
2375 collapsed." | |
2376 (interactive "P") | |
2377 (if (kcell-view:collapsed-p) | |
2378 ;; expand cells | |
2379 (kotl-mode:expand-tree all-flag) | |
2380 (kotl-mode:collapse-tree all-flag))) | |
2381 | |
2382 ;;; | |
2383 (defun kotl-mode:overview () | |
2384 "Show the first line of each cell without blank line separators." | |
2385 (interactive) | |
2386 (kotl-mode:show-all) | |
2387 (if (string-match "b" kvspec:current) | |
2388 (kvspec:toggle-blank-lines)) | |
2389 (kotl-mode:collapse-tree t)) | |
2390 | |
2391 (defun kotl-mode:show-all () | |
2392 "Show (expand) all cells in current view." | |
2393 (interactive) | |
2394 (if (kotl-mode:is-p) | |
2395 (progn (kview:set-attr kview 'levels-to-show 0) | |
2396 (kview:set-attr kview 'lines-to-show 0) | |
2397 (show-all) | |
2398 (kvspec:update t)))) | |
2399 | |
2400 (defun kotl-mode:top-cells () | |
2401 "Collapse all level 1 cells in view and hide any deeper sublevels." | |
2402 (interactive) | |
2403 (kotl-mode:is-p) | |
2404 (let ((modified-p (buffer-modified-p)) | |
2405 (buffer-read-only)) | |
2406 (kvspec:levels-to-show 1) | |
2407 (kvspec:show-lines-per-cell 1) | |
2408 (kvspec:update t) | |
2409 ;; Restore buffer modification status | |
2410 (set-buffer-modified-p modified-p))) | |
2411 | |
2412 ;;; | |
2413 (defun kotl-mode:hide-sublevels (levels-to-keep) | |
2414 "Hide all cells in outline at levels deeper than LEVELS-TO-KEEP (a number). | |
2415 Shows any hidden cells within LEVELS-TO-KEEP. 1 is the first level. 0 means | |
2416 display all levels of cells." | |
2417 (interactive "P") | |
2418 (kvspec:levels-to-show levels-to-keep) | |
2419 ;; The prior call might have shown more lines per cell than the current | |
2420 ;; viewspec supports, so reset lines per cell. | |
2421 (kvspec:lines-to-show) | |
2422 (kvspec:update t)) | |
2423 | |
2424 (defun kotl-mode:hide-subtree (&optional cell-ref show-flag) | |
2425 "Hide subtree, ignoring root, at optional CELL-REF (defaults to cell at point)." | |
2426 (interactive) | |
2427 (kotl-mode:is-p) | |
2428 (save-excursion | |
2429 (if cell-ref | |
2430 (kotl-mode:goto-cell cell-ref t) | |
2431 (kotl-mode:beginning-of-cell)) | |
2432 (let ((start (kcell-view:end-contents)) | |
2433 (end (kotl-mode:tree-end t)) | |
2434 (buffer-read-only)) | |
2435 (if show-flag | |
2436 (subst-char-in-region start end ?\r ?\n t) | |
2437 (subst-char-in-region start end ?\n ?\r t))))) | |
2438 | |
2439 (defun kotl-mode:show-subtree (&optional cell-ref) | |
2440 "Show subtree, ignoring root, at optional CELL-REF (defaults to cell at point)." | |
2441 (interactive) | |
2442 (kotl-mode:hide-subtree cell-ref t)) | |
2443 | |
2444 (defun kotl-mode:hide-tree (&optional cell-ref show-flag) | |
2445 "Collapse tree rooted at optional CELL-REF (defaults to cell at point)." | |
2446 (interactive) | |
2447 (kotl-mode:is-p) | |
2448 (save-excursion | |
2449 (let ((start (if cell-ref | |
2450 (kotl-mode:goto-cell cell-ref t) | |
2451 (kotl-mode:beginning-of-cell))) | |
2452 (end (kotl-mode:tree-end t)) | |
2453 (buffer-read-only)) | |
2454 (if show-flag | |
2455 (subst-char-in-region start end ?\r ?\n t) | |
2456 (subst-char-in-region start end ?\n ?\r t))))) | |
2457 | |
2458 (defun kotl-mode:show-tree (&optional cell-ref) | |
2459 "Display fully expanded tree rooted at CELL-REF." | |
2460 (interactive) | |
2461 (kotl-mode:hide-tree cell-ref t)) | |
2462 | |
2463 ;;; | |
2464 (defun kotl-mode:cell-attributes (all-flag) | |
2465 "Display a temporary buffer with the attributes of the current kcell. | |
2466 With prefix arg ALL-FLAG non-nil, display the attributes of all visible | |
2467 kcells in the current buffer. | |
2468 | |
2469 See also the documentation for `kotl-mode:cell-help'." | |
2470 (interactive "P") | |
2471 (with-output-to-temp-buffer | |
2472 (hypb:help-buf-name "Kotl") | |
2473 (save-excursion | |
2474 (if (not all-flag) | |
2475 (kotl-mode:print-attributes kview) | |
2476 (let ((label-sep-len (kview:label-separator-length kview))) | |
2477 (kotl-mode:beginning-of-buffer) | |
2478 (while (progn (kotl-mode:print-attributes kview) | |
2479 (kcell-view:next t label-sep-len)))))))) | |
2480 | |
2481 (defun kotl-mode:cell-help (&optional cell-ref cells-flag) | |
2482 "Display a temporary buffer with CELL-REF's attributes. | |
2483 CELL-REF defaults to current cell. | |
2484 Optional prefix arg CELLS-FLAG selects the cells to print: | |
2485 If = 1, print CELL-REF's cell only; | |
2486 If > 1, print CELL-REF's visible tree (the tree rooted at CELL-REF); | |
2487 If < 1, print all visible cells in current view (CELL-REF is not used). | |
2488 | |
2489 See also the documentation for `kotl-mode:cell-attributes'." | |
2490 (interactive | |
2491 (let* ((label (kcell-view:label)) | |
2492 (hargs:defaults (list label label))) | |
2493 (append | |
2494 (let ((arg (prefix-numeric-value current-prefix-arg))) | |
2495 (if (< arg 1) | |
2496 0 | |
2497 (hargs:iform-read | |
2498 (list 'interactive | |
2499 (format "+KDisplay properties of koutline %s: " | |
2500 (if (= arg 1) "cell" "tree")))))) | |
2501 (list current-prefix-arg)))) | |
2502 (or (integerp cells-flag) | |
2503 (setq cells-flag (prefix-numeric-value cells-flag))) | |
2504 (or (stringp cell-ref) (setq cell-ref (kcell-view:label))) | |
2505 (with-output-to-temp-buffer | |
2506 (hypb:help-buf-name "Koutline") | |
2507 (save-excursion | |
2508 (if (equal cell-ref "0") | |
2509 (progn | |
2510 (hattr:report (kcell:plist (kview:top-cell kview))) | |
2511 (terpri) | |
2512 (cond ((= cells-flag 1) nil) | |
2513 ((> cells-flag 1) | |
2514 (kview:map-tree 'kotl-mode:print-attributes kview t t)) | |
2515 ;; (< cells-flag 1) | |
2516 (t (kotl-mode:cell-attributes t)))) | |
2517 (cond ((= cells-flag 1) | |
2518 (kotl-mode:goto-cell cell-ref) | |
2519 (kotl-mode:print-attributes kview)) | |
2520 ((> cells-flag 1) | |
2521 (kotl-mode:goto-cell cell-ref) | |
2522 (kview:map-tree 'kotl-mode:print-attributes kview nil t)) | |
2523 ;; (< cells-flag 1) | |
2524 (t (kotl-mode:cell-attributes t))))))) | |
2525 | |
2526 (defun kotl-mode:get-cell-attribute (attribute &optional pos) | |
2527 "Return ATTRIBUTE's value for the current cell or the cell at optional POS. | |
2528 When called interactively, it displays the value in the minibuffer." | |
2529 (interactive "SCurrent cell attribute to get: ") | |
2530 (let ((value (kcell-view:get-attr attribute pos))) | |
2531 (if (interactive-p) | |
2532 (message "Attribute \"%s\" = `%s' in cell <%s>." | |
2533 attribute value (kcell-view:label pos))) | |
2534 value)) | |
2535 | |
2536 ;;; ************************************************************************ | |
2537 ;;; Private functions | |
2538 ;;; ************************************************************************ | |
2539 | |
2540 (defun kotl-mode:add-indent-to-region (&optional indent start end) | |
2541 "Add current cell's indent to current region. | |
2542 Optionally, INDENT and region START and END may be given." | |
2543 (or (integerp indent) (setq indent (kcell-view:indent))) | |
2544 (save-excursion | |
2545 (save-restriction | |
2546 (narrow-to-region (or start (point)) (or end (hypb:mark t))) | |
2547 (goto-char (point-min)) | |
2548 (replace-regexp "\n" (concat "\n" (make-string indent ?\ )))))) | |
2549 | |
2550 (defun kotl-mode:delete-line (&optional pos) | |
2551 "Delete and return contents of cell line at point or optional POS as a string. | |
2552 Does not delete newline at end of line." | |
2553 (save-excursion | |
2554 (if pos (goto-char pos)) | |
2555 (if (kview:valid-position-p) | |
2556 (let ((bol (kotl-mode:start-of-line)) | |
2557 (eol (kotl-mode:finish-of-line))) | |
2558 (prog1 | |
2559 (buffer-substring bol eol) | |
2560 (delete-region bol eol))) | |
2561 (error "(kotl-mode:delete-line): Invalid position, '%d'" (point))))) | |
2562 | |
2563 (defun kotl-mode:indent-line (arg) | |
2564 ;; Disallow the indent-line command. | |
2565 (error "(kotl-mode:indent-line): Insert spaces to indent each line.")) | |
2566 | |
2567 (defun kotl-mode:indent-region (start end) | |
2568 ;; User might try to indent across cells. This would be bad, so disallow | |
2569 ;; the indent-region command. | |
2570 (error "(kotl-mode:indent-region): Insert spaces to indent each line.")) | |
2571 | |
2572 (defun kotl-mode:is-p () | |
2573 "Signal an error if current buffer is not a Hyperbole outline, else return t." | |
2574 (if (kview:is-p kview) | |
2575 t | |
2576 (hypb:error | |
2577 "(kotl-mode:is-p): Command requires a current Hyperbole outline."))) | |
2578 | |
2579 (defun kotl-mode:tree-end (&optional omit-end-newlines) | |
2580 "Return end point of current cell's tree within this view. | |
2581 If optional OMIT-END-NEWLINES is non-nil, point returned precedes any | |
2582 newlines at end of tree." | |
2583 (let* ((label-sep-len (kview:label-separator-length kview)) | |
2584 (start-indent (kcell-view:indent nil label-sep-len)) | |
2585 (next)) | |
2586 (save-excursion | |
2587 (while (and (setq next (kcell-view:next nil label-sep-len)) | |
2588 (< start-indent (kcell-view:indent nil label-sep-len)))) | |
2589 (cond (next | |
2590 (goto-char (progn (kcell-view:previous nil label-sep-len) | |
2591 (kcell-view:end)))) | |
2592 ;; Avoid skipping too far at end of file. | |
2593 ((re-search-forward "[\n\r][\n\r]" nil t)) | |
2594 (t (goto-char (point-max)))) | |
2595 (if omit-end-newlines (skip-chars-backward "\n\r")) | |
2596 (point)))) | |
2597 | |
2598 (defun kotl-mode:tree-start () | |
2599 "Return beginning of line position preceding current cell's start point." | |
2600 (save-excursion (goto-char (kcell-view:start)) (beginning-of-line) | |
2601 (point))) | |
2602 | |
2603 (defun kotl-mode:line-move (arg) | |
2604 "Move point ARG visible lines forward within an outline." | |
2605 (if (not (integerp selective-display)) | |
2606 (forward-line arg) | |
2607 ;; Move by arg lines, but ignore invisible ones. | |
2608 (while (> arg 0) | |
2609 (vertical-motion 1) | |
2610 (forward-char -1) | |
2611 (forward-line 1) | |
2612 (setq arg (1- arg))) | |
2613 (while (< arg 0) | |
2614 (vertical-motion -1) | |
2615 (beginning-of-line) | |
2616 (setq arg (1+ arg)))) | |
2617 (move-to-column (or goal-column temporary-goal-column)) | |
2618 nil) | |
2619 | |
2620 (defun kotl-mode:print-attributes (kview) | |
2621 "Print to the `standard-output' stream the attributes of the current visible kcell. | |
2622 Takes argument KVIEW (so it can be used with 'kview:map-tree' and so that | |
2623 KVIEW is bound correctly) but always operates upon the current view." | |
2624 ;; Move to start of visible cell to avoid printing attributes for an | |
2625 ;; invisible kcell which point may be over. | |
2626 ;; Print first line of cell for reference. | |
2627 (save-excursion | |
2628 (princ | |
2629 (buffer-substring (progn (beginning-of-line) (point)) | |
2630 (progn (kview:end-of-actual-line) | |
2631 (point))))) | |
2632 (terpri) | |
2633 (hattr:report (kcell:plist (kcell-view:cell))) | |
2634 (terpri)) | |
2635 | |
2636 (defun kotl-mode:set-temp-goal-column () | |
2637 (if (not (or (eq last-command 'next-line) | |
2638 (eq last-command 'previous-line))) | |
2639 (setq temporary-goal-column | |
2640 (if (and track-eol (eolp) | |
2641 ;; Don't count beg of empty line as end of line | |
2642 ;; unless we just did explicit end-of-line. | |
2643 (or (not (bolp)) (eq last-command 'end-of-line))) | |
2644 9999 | |
2645 (current-column))))) | |
2646 | |
2647 (defun kotl-mode:to-valid-position (&optional backward-p) | |
2648 "Move point to the nearest non-read-only position within current koutline view. | |
2649 With optional BACKWARD-P, move backward if possible to get to valid position." | |
2650 (if (kview:valid-position-p) | |
2651 nil | |
2652 (let ((label-sep-len (kview:label-separator-length kview))) | |
2653 (cond ((kotl-mode:bobp) | |
2654 (goto-char (kcell-view:start nil label-sep-len))) | |
2655 ((kotl-mode:eobp) | |
2656 (skip-chars-backward "\n\r")) | |
2657 (t (let ((indent (kcell-view:indent nil label-sep-len))) | |
2658 (if (bolp) | |
2659 (if backward-p | |
2660 (skip-chars-backward "\n\r") | |
2661 (skip-chars-forward "\n\r"))) | |
2662 (setq indent (kcell-view:indent nil label-sep-len)) | |
2663 (if (< (current-column) indent) | |
2664 (move-to-column indent)))))))) | |
2665 | |
2666 (defun kotl-mode:transpose-lines-internal (start end) | |
2667 "Transpose lines at START and END markers within an outline. | |
2668 Leave point at end of line now residing at START." | |
2669 (if (and start end | |
2670 (kview:valid-position-p start) | |
2671 (kview:valid-position-p end)) | |
2672 (let* ((pline (kotl-mode:delete-line start)) | |
2673 mline) | |
2674 (goto-char end) | |
2675 (setq mline (kotl-mode:delete-line)) | |
2676 (insert pline) | |
2677 (goto-char start) | |
2678 (insert mline)) | |
2679 ;; Set non-point and non-mark markers to point nowhere before signalling | |
2680 ;; an error. | |
2681 (or (eq start (point-marker)) | |
2682 (eq start (hypb:mark-marker t)) | |
2683 (set-marker start nil)) | |
2684 (or (eq end (point-marker)) | |
2685 (eq end (hypb:mark-marker t)) | |
2686 (set-marker start nil)) | |
2687 (error "(kotl-mode:transpose-lines): Point or mark is at an invalid position"))) | |
2688 | |
2689 (defun kotl-mode:update-buffer () | |
2690 "Update current view buffer in preparation for saving." | |
2691 (if (kview:is-p kview) | |
2692 (let ((mod-p (buffer-modified-p)) | |
2693 (start (window-start))) | |
2694 (save-excursion | |
2695 (kfile:update) | |
2696 (set-buffer-modified-p mod-p)) | |
2697 (set-window-start nil (max (point-min) start) t) | |
2698 nil))) | |
2699 | |
2700 ;;; ------------------------------------------------------------------------ | |
2701 | |
2702 (defvar kotl-mode-map nil | |
2703 "Keymap containing koutliner editing and viewing commands.") | |
2704 (if kotl-mode-map | |
2705 nil | |
2706 (setq kotl-mode-map | |
2707 (if (string-match "XEmacs\\|Lucid" emacs-version) | |
2708 (make-keymap) | |
2709 (copy-keymap indented-text-mode-map))) | |
2710 ;; Overload edit keys to deal with structure and labels. | |
2711 (let (local-cmd) | |
2712 (mapcar | |
2713 (if (string-match "XEmacs\\|Lucid" emacs-version) | |
2714 ;; XEmacs | |
2715 (function | |
2716 (lambda (cmd) | |
2717 (setq local-cmd (intern-soft | |
2718 (concat "kotl-mode:" (symbol-name cmd)))) | |
2719 ;; Only bind key locally if kotl-mode local-cmd has already | |
2720 ;; been defined and cmd is a valid function. | |
2721 (if (and local-cmd (fboundp cmd)) | |
2722 (progn | |
2723 ;; Make local-cmd have the same property list as cmd, | |
2724 ;; e.g. so pending-delete property is the same. | |
2725 (setplist local-cmd (symbol-plist cmd)) | |
2726 (mapcar | |
2727 (function | |
2728 (lambda (key) (define-key kotl-mode-map key local-cmd))) | |
2729 (where-is-internal cmd)))))) | |
2730 ;; GNU Emacs 19 | |
2731 (function | |
2732 (lambda (cmd) | |
2733 (setq local-cmd (intern-soft | |
2734 (concat "kotl-mode:" (symbol-name cmd)))) | |
2735 ;; Only bind key locally if kotl-mode local-cmd has already | |
2736 ;; been defined and cmd is a valid function. | |
2737 (if (and local-cmd (fboundp cmd)) | |
2738 (progn | |
2739 ;; Make local-cmd have the same property list as cmd, | |
2740 ;; e.g. so pending-delete property is the same. | |
2741 (setplist local-cmd (symbol-plist cmd)) | |
2742 (substitute-key-definition | |
2743 cmd local-cmd kotl-mode-map global-map)))))) | |
2744 '( | |
2745 back-to-indentation | |
2746 backward-char | |
2747 backward-delete-char | |
2748 backward-delete-char-untabify | |
2749 backward-kill-word | |
2750 backward-para | |
2751 backward-paragraph | |
2752 backward-sentence | |
2753 backward-word | |
2754 beginning-of-buffer | |
2755 beginning-of-line | |
2756 copy-region-as-kill | |
2757 copy-to-register | |
2758 delete-blank-lines | |
2759 delete-backward-char | |
2760 delete-char | |
2761 delete-horizontal-space | |
2762 delete-indentation | |
2763 end-of-buffer | |
2764 end-of-line | |
2765 fill-paragraph | |
2766 fill-paragraph-or-region | |
2767 ;; cursor keys | |
2768 fkey-backward-char | |
2769 fkey-forward-char | |
2770 fkey-next-line | |
2771 fkey-previous-line | |
2772 ;; | |
2773 forward-char | |
2774 forward-word | |
2775 forward-para | |
2776 forward-paragraph | |
2777 forward-sentence | |
2778 insert-buffer | |
2779 insert-file | |
2780 insert-register | |
2781 just-one-space | |
2782 kill-word | |
2783 kill-line | |
2784 kill-region | |
2785 kill-ring-save | |
2786 kill-sentence | |
2787 mark-paragraph | |
2788 mark-whole-buffer | |
2789 newline | |
2790 newline-and-indent | |
2791 next-line | |
2792 open-line | |
2793 previous-line | |
2794 scroll-down | |
2795 scroll-up | |
2796 set-fill-prefix | |
2797 transpose-chars | |
2798 transpose-lines | |
2799 transpose-paragraphs | |
2800 transpose-sentences | |
2801 transpose-words | |
2802 yank | |
2803 yank-pop | |
2804 zap-to-char | |
2805 ))) | |
2806 | |
2807 | |
2808 ;; kotl-mode keys | |
2809 (define-key kotl-mode-map "\C-c@" 'kotl-mode:mail-tree) | |
2810 (define-key kotl-mode-map "\C-c+" 'kotl-mode:append-cell) | |
2811 (define-key kotl-mode-map "\C-c," 'kotl-mode:beginning-of-cell) | |
2812 (define-key kotl-mode-map "\C-c." 'kotl-mode:end-of-cell) | |
2813 (define-key kotl-mode-map "\C-c<" 'kotl-mode:first-sibling) | |
2814 (define-key kotl-mode-map "\C-c>" 'kotl-mode:last-sibling) | |
2815 (define-key kotl-mode-map "\C-c^" 'kotl-mode:beginning-of-tree) | |
2816 (define-key kotl-mode-map "\C-c$" 'kotl-mode:end-of-tree) | |
2817 (define-key kotl-mode-map "\C-ca" 'kotl-mode:add-child) | |
2818 (define-key kotl-mode-map "\C-c\C-a" 'kotl-mode:show-all) | |
2819 (define-key kotl-mode-map "\C-cb" 'kvspec:toggle-blank-lines) | |
2820 (define-key kotl-mode-map "\C-c\C-b" 'kotl-mode:backward-cell) | |
2821 (define-key kotl-mode-map "\C-cc" 'kotl-mode:copy-after) | |
2822 (define-key kotl-mode-map "\C-c\C-c" 'kotl-mode:copy-before) | |
2823 (define-key kotl-mode-map "\C-c\M-c" 'kotl-mode:copy-to-buffer) | |
2824 (define-key kotl-mode-map "\C-cd" 'kotl-mode:down-level) | |
2825 (define-key kotl-mode-map "\C-c\C-d" 'kotl-mode:down-level) | |
2826 (define-key kotl-mode-map "\C-ce" 'kotl-mode:exchange-cells) | |
2827 (define-key kotl-mode-map "\C-c\C-f" 'kotl-mode:forward-cell) | |
2828 (define-key kotl-mode-map "\C-cg" 'kotl-mode:goto-cell) | |
2829 (define-key kotl-mode-map "\C-ch" 'kotl-mode:cell-help) | |
2830 (define-key kotl-mode-map "\C-c\C-h" 'kotl-mode:hide-tree) | |
2831 (define-key kotl-mode-map "\M-\C-h" 'kotl-mode:hide-subtree) | |
2832 ;; Override this global binding for set-selective-display with a similar | |
2833 ;; function appropriate for kotl-mode. | |
2834 (define-key kotl-mode-map "\C-x$" 'kotl-mode:hide-sublevels) | |
2835 (define-key kotl-mode-map "\C-i" 'kotl-mode:demote-tree) | |
2836 (define-key kotl-mode-map "\M-\C-i" 'kotl-mode:promote-tree) | |
2837 (define-key kotl-mode-map "\C-j" 'kotl-mode:add-cell) | |
2838 (define-key kotl-mode-map "\M-j" 'kotl-mode:fill-paragraph) | |
2839 (define-key kotl-mode-map "\C-c\M-j" 'kotl-mode:fill-cell) | |
2840 (define-key kotl-mode-map "\M-\C-j" 'kotl-mode:fill-tree) | |
2841 (define-key kotl-mode-map "\C-c\C-k" 'kotl-mode:kill-tree) | |
2842 (define-key kotl-mode-map "\C-ck" 'kotl-mode:kill-contents) | |
2843 (define-key kotl-mode-map "\C-c\C-i" 'kotl-mode:set-cell-attribute) | |
2844 (define-key kotl-mode-map "\C-cl" 'klink:create) | |
2845 (define-key kotl-mode-map "\C-c\C-l" 'kview:set-label-type) | |
2846 (define-key kotl-mode-map "\C-c\M-l" 'kview:set-label-separator) | |
2847 (define-key kotl-mode-map "\C-m" 'kotl-mode:newline) | |
2848 (define-key kotl-mode-map "\C-cm" 'kotl-mode:move-after) | |
2849 (define-key kotl-mode-map "\C-c\C-m" 'kotl-mode:move-before) | |
2850 (define-key kotl-mode-map "\C-c\C-n" 'kotl-mode:next-cell) | |
2851 (define-key kotl-mode-map "\C-c\C-o" 'kotl-mode:overview) | |
2852 (define-key kotl-mode-map "\C-c\C-p" 'kotl-mode:previous-cell) | |
2853 (define-key kotl-mode-map "\C-cp" 'kotl-mode:add-parent) | |
2854 (if (memq (global-key-binding "\M-q") '(fill-paragraph | |
2855 fill-paragraph-or-region)) | |
2856 (progn | |
2857 (define-key kotl-mode-map "\C-c\M-q" 'kotl-mode:fill-cell) | |
2858 (define-key kotl-mode-map "\M-\C-q" 'kotl-mode:fill-tree))) | |
2859 (define-key kotl-mode-map "\C-cs" 'kotl-mode:split-cell) | |
2860 (define-key kotl-mode-map "\C-c\C-s" 'kotl-mode:show-tree) | |
2861 (define-key kotl-mode-map "\C-c\C-\\" 'kotl-mode:show-tree) | |
2862 (define-key kotl-mode-map "\M-s" 'kotl-mode:center-line) | |
2863 (define-key kotl-mode-map "\M-S" 'kotl-mode:center-paragraph) | |
2864 (define-key kotl-mode-map "\C-ct" 'kotl-mode:transpose-cells) | |
2865 (define-key kotl-mode-map "\C-c\C-t" 'kotl-mode:top-cells) | |
2866 (define-key kotl-mode-map "\C-cu" 'kotl-mode:up-level) | |
2867 (define-key kotl-mode-map "\C-c\C-u" 'kotl-mode:up-level) | |
2868 (define-key kotl-mode-map "\C-c\C-v" 'kvspec:activate) | |
2869 (define-key kotl-mode-map "\C-x\C-w" 'kfile:write)) | |
2870 | |
2871 (provide 'kotl-mode) |