5 |
;; Author: Thien-Thi Nguyen <ttn@gnu.org> |
;; Author: Thien-Thi Nguyen <ttn@gnu.org> |
6 |
;; Dan Nicolaescu <dann@ics.uci.edu> |
;; Dan Nicolaescu <dann@ics.uci.edu> |
7 |
;; Keywords: C C++ java lisp tools editing comments blocks hiding outlines |
;; Keywords: C C++ java lisp tools editing comments blocks hiding outlines |
8 |
;; Maintainer-Version: 5.39.2.8 |
;; Maintainer-Version: 5.58.2.3 |
9 |
;; Time-of-Day-Author-Most-Likely-to-be-Recalcitrant: early morning |
;; Time-of-Day-Author-Most-Likely-to-be-Recalcitrant: early morning |
10 |
|
|
11 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
138 |
;; If you have an entry that works particularly well, consider |
;; If you have an entry that works particularly well, consider |
139 |
;; submitting it for inclusion in hideshow.el. See docstring for |
;; submitting it for inclusion in hideshow.el. See docstring for |
140 |
;; `hs-special-modes-alist' for more info on the entry format. |
;; `hs-special-modes-alist' for more info on the entry format. |
141 |
|
;; |
142 |
|
;; See also variable `hs-set-up-overlay' for per-block customization of |
143 |
|
;; appearance or other effects associated with overlays. For example: |
144 |
|
;; |
145 |
|
;; (setq hs-set-up-overlay |
146 |
|
;; (defun my-display-code-line-counts (ov) |
147 |
|
;; (when (eq 'code (overlay-get ov 'hs)) |
148 |
|
;; (overlay-put ov 'display |
149 |
|
;; (propertize |
150 |
|
;; (format " ... <%d>" |
151 |
|
;; (count-lines (overlay-start ov) |
152 |
|
;; (overlay-end ov))) |
153 |
|
;; 'face 'font-lock-type-face))))) |
154 |
|
|
155 |
;; * Bugs |
;; * Bugs |
156 |
;; |
;; |
317 |
These commands include the toggling commands (when the result is to show |
These commands include the toggling commands (when the result is to show |
318 |
a block), `hs-show-all' and `hs-show-block'..") |
a block), `hs-show-all' and `hs-show-block'..") |
319 |
|
|
320 |
|
(defvar hs-set-up-overlay nil |
321 |
|
"*Function called with one arg, OV, a newly initialized overlay. |
322 |
|
Hideshow puts a unique overlay on each range of text to be hidden |
323 |
|
in the buffer. Here is a simple example of how to use this variable: |
324 |
|
|
325 |
|
(defun display-code-line-counts (ov) |
326 |
|
(when (eq 'code (overlay-get ov 'hs)) |
327 |
|
(overlay-put ov 'display |
328 |
|
(format \"... / %d\" |
329 |
|
(count-lines (overlay-start ov) |
330 |
|
(overlay-end ov)))))) |
331 |
|
|
332 |
|
(setq hs-set-up-overlay 'display-code-line-counts) |
333 |
|
|
334 |
|
This example shows how to get information from the overlay as well |
335 |
|
as how to set its `display' property. See `hs-make-overlay' and |
336 |
|
info node `(elisp)Overlays'.") |
337 |
|
|
338 |
;;--------------------------------------------------------------------------- |
;;--------------------------------------------------------------------------- |
339 |
;; internal variables |
;; internal variables |
340 |
|
|
419 |
(when (overlay-get ov 'hs) |
(when (overlay-get ov 'hs) |
420 |
(delete-overlay ov)))) |
(delete-overlay ov)))) |
421 |
|
|
422 |
|
(defun hs-make-overlay (b e kind &optional b-offset e-offset) |
423 |
|
"Return a new overlay in region defined by B and E with type KIND. |
424 |
|
KIND is either `code' or `comment'. Optional fourth arg B-OFFSET |
425 |
|
when added to B specifies the actual buffer position where the block |
426 |
|
begins. Likewise for optional fifth arg E-OFFSET. If unspecified |
427 |
|
they are taken to be 0 (zero). The following properties are set |
428 |
|
in the overlay: 'invisible 'hs 'hs-b-offset 'hs-e-offset. Also, |
429 |
|
depending on variable `hs-isearch-open', the following properties may |
430 |
|
be present: 'isearch-open-invisible 'isearch-open-invisible-temporary. |
431 |
|
If variable `hs-set-up-overlay' is non-nil it should specify a function |
432 |
|
to call with the newly initialized overlay." |
433 |
|
(unless b-offset (setq b-offset 0)) |
434 |
|
(unless e-offset (setq e-offset 0)) |
435 |
|
(let ((ov (make-overlay b e)) |
436 |
|
(io (if (eq 'block hs-isearch-open) |
437 |
|
;; backward compatibility -- `block'<=>`code' |
438 |
|
'code |
439 |
|
hs-isearch-open))) |
440 |
|
(overlay-put ov 'invisible 'hs) |
441 |
|
(overlay-put ov 'hs kind) |
442 |
|
(overlay-put ov 'hs-b-offset b-offset) |
443 |
|
(overlay-put ov 'hs-e-offset e-offset) |
444 |
|
(when (or (eq io t) (eq io kind)) |
445 |
|
(overlay-put ov 'isearch-open-invisible 'hs-isearch-show) |
446 |
|
(overlay-put ov 'isearch-open-invisible-temporary |
447 |
|
'hs-isearch-show-temporary)) |
448 |
|
(when hs-set-up-overlay (funcall hs-set-up-overlay ov)) |
449 |
|
ov)) |
450 |
|
|
451 |
(defun hs-isearch-show (ov) |
(defun hs-isearch-show (ov) |
452 |
"Delete overlay OV, and set `hs-headline' to nil. |
"Delete overlay OV, and set `hs-headline' to nil. |
453 |
|
|
476 |
(point)) |
(point)) |
477 |
start))))) |
start))))) |
478 |
(force-mode-line-update) |
(force-mode-line-update) |
479 |
|
;; handle `display' property specially |
480 |
|
(let (value) |
481 |
|
(if hide-p |
482 |
|
(when (setq value (overlay-get ov 'hs-isearch-display)) |
483 |
|
(overlay-put ov 'display value) |
484 |
|
(overlay-put ov 'hs-isearch-display nil)) |
485 |
|
(when (setq value (overlay-get ov 'display)) |
486 |
|
(overlay-put ov 'hs-isearch-display value) |
487 |
|
(overlay-put ov 'display nil)))) |
488 |
(overlay-put ov 'invisible (and hide-p 'hs))) |
(overlay-put ov 'invisible (and hide-p 'hs))) |
489 |
|
|
|
(defun hs-flag-region (from to flag) |
|
|
"Hide or show lines from FROM to TO, according to FLAG. |
|
|
If FLAG is nil then text is shown, while if FLAG is non-nil the text is |
|
|
hidden. FLAG must be one of the symbols `code' or `comment', depending |
|
|
on what kind of block is to be hidden." |
|
|
(save-excursion |
|
|
;; first clear it all out |
|
|
(hs-discard-overlays from to) |
|
|
;; now create overlays if needed |
|
|
(when flag |
|
|
(let ((overlay (make-overlay from to))) |
|
|
(overlay-put overlay 'invisible 'hs) |
|
|
(overlay-put overlay 'hs flag) |
|
|
(when (or (eq hs-isearch-open t) |
|
|
(eq hs-isearch-open flag) |
|
|
;; deprecated backward compatibility -- `block'<=>`code' |
|
|
(and (eq 'block hs-isearch-open) |
|
|
(eq 'code flag))) |
|
|
(overlay-put overlay 'isearch-open-invisible 'hs-isearch-show) |
|
|
(overlay-put overlay |
|
|
'isearch-open-invisible-temporary |
|
|
'hs-isearch-show-temporary)) |
|
|
overlay)))) |
|
|
|
|
490 |
(defun hs-forward-sexp (match-data arg) |
(defun hs-forward-sexp (match-data arg) |
491 |
"Adjust point based on MATCH-DATA and call `hs-forward-sexp-func' w/ ARG. |
"Adjust point based on MATCH-DATA and call `hs-forward-sexp-func' w/ ARG. |
492 |
Original match data is restored upon return." |
Original match data is restored upon return." |
498 |
(defun hs-hide-comment-region (beg end &optional repos-end) |
(defun hs-hide-comment-region (beg end &optional repos-end) |
499 |
"Hide a region from BEG to END, marking it as a comment. |
"Hide a region from BEG to END, marking it as a comment. |
500 |
Optional arg REPOS-END means reposition at end." |
Optional arg REPOS-END means reposition at end." |
501 |
(hs-flag-region (progn (goto-char beg) (end-of-line) (point)) |
(let ((beg-eol (progn (goto-char beg) (end-of-line) (point))) |
502 |
(progn (goto-char end) (end-of-line) (point)) |
(end-eol (progn (goto-char end) (end-of-line) (point)))) |
503 |
'comment) |
(hs-discard-overlays beg-eol end-eol) |
504 |
|
(hs-make-overlay beg-eol end-eol 'comment beg end)) |
505 |
(goto-char (if repos-end end beg))) |
(goto-char (if repos-end end beg))) |
506 |
|
|
507 |
(defun hs-hide-block-at-point (&optional end comment-reg) |
(defun hs-hide-block-at-point (&optional end comment-reg) |
534 |
(end-of-line) |
(end-of-line) |
535 |
(point)))) |
(point)))) |
536 |
(when (and (< p (point)) (> (count-lines p q) 1)) |
(when (and (< p (point)) (> (count-lines p q) 1)) |
537 |
(overlay-put (hs-flag-region p q 'code) |
(hs-discard-overlays p q) |
538 |
'hs-ofs |
(hs-make-overlay p q 'code (- pure-p p))) |
|
(- pure-p p))) |
|
539 |
(goto-char (if end q (min p pure-p))))))) |
(goto-char (if end q (min p pure-p))))))) |
540 |
|
|
541 |
(defun hs-safety-is-job-n () |
(defun hs-safety-is-job-n () |
657 |
(setq minp (1+ (point))) |
(setq minp (1+ (point))) |
658 |
(funcall hs-forward-sexp-func 1) |
(funcall hs-forward-sexp-func 1) |
659 |
(setq maxp (1- (point)))) |
(setq maxp (1- (point)))) |
660 |
(hs-flag-region minp maxp nil) ; eliminate weirdness |
(hs-discard-overlays minp maxp) ; eliminate weirdness |
661 |
(goto-char minp) |
(goto-char minp) |
662 |
(while (progn |
(while (progn |
663 |
(forward-comment (buffer-size)) |
(forward-comment (buffer-size)) |
723 |
(hs-life-goes-on |
(hs-life-goes-on |
724 |
(message "Hiding all blocks ...") |
(message "Hiding all blocks ...") |
725 |
(save-excursion |
(save-excursion |
726 |
(hs-flag-region (point-min) (point-max) nil) ; eliminate weirdness |
(hs-discard-overlays (point-min) (point-max)) ; eliminate weirdness |
727 |
(goto-char (point-min)) |
(goto-char (point-min)) |
728 |
(let ((count 0) |
(let ((count 0) |
729 |
(re (concat "\\(" |
(re (concat "\\(" |
762 |
(interactive) |
(interactive) |
763 |
(hs-life-goes-on |
(hs-life-goes-on |
764 |
(message "Showing all blocks ...") |
(message "Showing all blocks ...") |
765 |
(hs-flag-region (point-min) (point-max) nil) |
(hs-discard-overlays (point-min) (point-max)) |
766 |
(message "Showing all blocks ... done") |
(message "Showing all blocks ... done") |
767 |
(run-hooks 'hs-show-hook))) |
(run-hooks 'hs-show-hook))) |
768 |
|
|
800 |
(goto-char |
(goto-char |
801 |
(cond (end (overlay-end ov)) |
(cond (end (overlay-end ov)) |
802 |
((eq 'comment (overlay-get ov 'hs)) here) |
((eq 'comment (overlay-get ov 'hs)) here) |
803 |
(t (+ (overlay-start ov) (overlay-get ov 'hs-ofs))))) |
(t (+ (overlay-start ov) (overlay-get ov 'hs-b-offset))))) |
804 |
(delete-overlay ov) |
(delete-overlay ov) |
805 |
(throw 'eol-begins-hidden-region-p t))) |
(throw 'eol-begins-hidden-region-p t))) |
806 |
nil)) |
nil)) |
816 |
(setq p (point) |
(setq p (point) |
817 |
q (progn (hs-forward-sexp (hs-match-data t) 1) (point))))) |
q (progn (hs-forward-sexp (hs-match-data t) 1) (point))))) |
818 |
(when (and p q) |
(when (and p q) |
819 |
(hs-flag-region p q nil) |
(hs-discard-overlays p q) |
820 |
(goto-char (if end q (1+ p))))) |
(goto-char (if end q (1+ p))))) |
821 |
(hs-safety-is-job-n) |
(hs-safety-is-job-n) |
822 |
(run-hooks 'hs-show-hook)))) |
(run-hooks 'hs-show-hook)))) |