Mercurial > emacs
comparison lisp/outline.el @ 65147:c5c1bf7f3c59
(outline-promote): Try shortening the heading.
As last resort, read the heading to use.
(outline-demote): As last resort, read the heading to use.
| author | Richard M. Stallman <rms@gnu.org> |
|---|---|
| date | Fri, 26 Aug 2005 11:52:08 +0000 |
| parents | 41bb365f41c4 |
| children | 1dc0c9b5d66a |
comparison
equal
deleted
inserted
replaced
| 65146:b69416140806 | 65147:c5c1bf7f3c59 |
|---|---|
| 469 (outline-map-region 'outline-promote | 469 (outline-map-region 'outline-promote |
| 470 (point) | 470 (point) |
| 471 (save-excursion (outline-get-next-sibling) (point)))) | 471 (save-excursion (outline-get-next-sibling) (point)))) |
| 472 (t | 472 (t |
| 473 (outline-back-to-heading t) | 473 (outline-back-to-heading t) |
| 474 (let* ((head (match-string 0)) | 474 (let* ((head (match-string-no-properties 0)) |
| 475 (level (save-match-data (funcall outline-level))) | 475 (level (save-match-data (funcall outline-level))) |
| 476 (up-head (or (outline-head-from-level (1- level) head) | 476 (up-head (or (outline-head-from-level (1- level) head) |
| 477 ;; Use the parent heading, if it is really | |
| 478 ;; one level less. | |
| 477 (save-excursion | 479 (save-excursion |
| 478 (save-match-data | 480 (save-match-data |
| 479 (outline-up-heading 1 t) | 481 (outline-up-heading 1 t) |
| 480 (match-string 0)))))) | 482 (and (= (1- level) (funcall outline-level)) |
| 483 (match-string-no-properties 0)))) | |
| 484 ;; Bummer!! There is no lower level heading. | |
| 485 ;; Let's try to invent one by deleting the last char. | |
| 486 (save-match-data | |
| 487 (let ((new-head (substring head 0 -1))) | |
| 488 (if (string-match (concat "\\`\\(?:" outline-regexp "\\)") | |
| 489 new-head) | |
| 490 ;; Why bother checking that it is indeed lower level ? | |
| 491 new-head | |
| 492 ;; Didn't work, so ask what to do. | |
| 493 (read-string (format "Parent heading for `%s': " | |
| 494 head) | |
| 495 head nil nil t))))))) | |
| 481 | 496 |
| 482 (unless (rassoc level outline-heading-alist) | 497 (unless (rassoc level outline-heading-alist) |
| 483 (push (cons head level) outline-heading-alist)) | 498 (push (cons head level) outline-heading-alist)) |
| 484 | 499 |
| 485 (replace-match up-head nil t))))) | 500 (replace-match up-head nil t))))) |
| 499 (children | 514 (children |
| 500 (outline-map-region 'outline-demote | 515 (outline-map-region 'outline-demote |
| 501 (point) | 516 (point) |
| 502 (save-excursion (outline-get-next-sibling) (point)))) | 517 (save-excursion (outline-get-next-sibling) (point)))) |
| 503 (t | 518 (t |
| 504 (let* ((head (match-string 0)) | 519 (let* ((head (match-string-no-properties 0)) |
| 505 (level (save-match-data (funcall outline-level))) | 520 (level (save-match-data (funcall outline-level))) |
| 506 (down-head | 521 (down-head |
| 507 (or (outline-head-from-level (1+ level) head) | 522 (or (outline-head-from-level (1+ level) head) |
| 508 (save-excursion | 523 (save-excursion |
| 509 (save-match-data | 524 (save-match-data |
| 514 (goto-char (point-min)) | 529 (goto-char (point-min)) |
| 515 (while (and (progn (outline-next-heading) (not (eobp))) | 530 (while (and (progn (outline-next-heading) (not (eobp))) |
| 516 (<= (funcall outline-level) level)))) | 531 (<= (funcall outline-level) level)))) |
| 517 (unless (eobp) | 532 (unless (eobp) |
| 518 (looking-at outline-regexp) | 533 (looking-at outline-regexp) |
| 519 (match-string 0)))) | 534 (match-string-no-properties 0)))) |
| 520 (save-match-data | 535 (save-match-data |
| 521 ;; Bummer!! There is no lower heading in the buffer. | 536 ;; Bummer!! There is no higher-level heading in the buffer. |
| 522 ;; Let's try to invent one by repeating the first char. | 537 ;; Let's try to invent one by repeating the last char. |
| 523 (let ((new-head (concat (substring head 0 1) head))) | 538 (let ((new-head (concat head (substring head -1)))) |
| 524 (if (string-match (concat "\\`\\(?:" outline-regexp "\\)") | 539 (if (string-match (concat "\\`\\(?:" outline-regexp "\\)") |
| 525 new-head) | 540 new-head) |
| 526 ;; Why bother checking that it is indeed lower level ? | 541 ;; Why bother checking that it is indeed higher level ? |
| 527 new-head | 542 new-head |
| 528 ;; Didn't work: keep it as is so it's still a heading. | 543 ;; Didn't work, so ask what to do. |
| 529 head)))))) | 544 (read-string (format "Demoted heading for `%s': " |
| 530 | 545 head) |
| 531 (unless (rassoc level outline-heading-alist) | 546 head nil nil t))))))) |
| 532 (push (cons head level) outline-heading-alist)) | 547 |
| 533 (replace-match down-head nil t))))) | 548 (unless (rassoc level outline-heading-alist) |
| 549 (push (cons head level) outline-heading-alist)) | |
| 550 (replace-match down-head nil t))))) | |
| 534 | 551 |
| 535 (defun outline-head-from-level (level head &optional alist) | 552 (defun outline-head-from-level (level head &optional alist) |
| 536 "Get new heading with level LEVEL from ALIST. | 553 "Get new heading with level LEVEL from ALIST. |
| 537 If there are no such entries, return nil. | 554 If there are no such entries, return nil. |
| 538 ALIST defaults to `outline-heading-alist'. | 555 ALIST defaults to `outline-heading-alist'. |