6 |
;; Author: Thien-Thi Nguyen <ttn@gnu.org> |
;; Author: Thien-Thi Nguyen <ttn@gnu.org> |
7 |
;; Dan Nicolaescu <dann@ics.uci.edu> |
;; Dan Nicolaescu <dann@ics.uci.edu> |
8 |
;; Keywords: C C++ java lisp tools editing comments blocks hiding outlines |
;; Keywords: C C++ java lisp tools editing comments blocks hiding outlines |
9 |
;; Maintainer-Version: |
;; Maintainer-Version: 5.65.2.2 |
10 |
;; Time-of-Day-Author-Most-Likely-to-be-Recalcitrant: early morning |
;; Time-of-Day-Author-Most-Likely-to-be-Recalcitrant: early morning |
11 |
|
|
12 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
243 |
:prefix "hs-" |
:prefix "hs-" |
244 |
:group 'languages) |
:group 'languages) |
245 |
|
|
|
;;;###autoload |
|
246 |
(defcustom hs-hide-comments-when-hiding-all t |
(defcustom hs-hide-comments-when-hiding-all t |
247 |
"*Hide the comments too when you do an `hs-hide-all'." |
"*Hide the comments too when you do an `hs-hide-all'." |
248 |
:type 'boolean |
:type 'boolean |
306 |
(defvar hs-hide-all-non-comment-function nil |
(defvar hs-hide-all-non-comment-function nil |
307 |
"*Function called if non-nil when doing `hs-hide-all' for non-comments.") |
"*Function called if non-nil when doing `hs-hide-all' for non-comments.") |
308 |
|
|
309 |
|
(defvar hs-allow-nesting nil |
310 |
|
"*If non-nil, hiding remembers internal blocks. |
311 |
|
This means that when the outer block is shown again, any |
312 |
|
previously hidden internal blocks remain hidden.") |
313 |
|
|
314 |
(defvar hs-hide-hook nil |
(defvar hs-hide-hook nil |
315 |
"*Hook called (with `run-hooks') at the end of commands to hide text. |
"*Hook called (with `run-hooks') at the end of commands to hide text. |
316 |
These commands include the toggling commands (when the result is to hide |
These commands include the toggling commands (when the result is to hide |
416 |
;; support functions |
;; support functions |
417 |
|
|
418 |
(defun hs-discard-overlays (from to) |
(defun hs-discard-overlays (from to) |
419 |
"Delete hideshow overlays in region defined by FROM and TO." |
"Delete hideshow overlays in region defined by FROM and TO. |
420 |
|
Skip \"internal\" overlays if `hs-allow-nesting' is non-nil." |
421 |
(when (< to from) |
(when (< to from) |
422 |
(setq from (prog1 to (setq to from)))) |
(setq from (prog1 to (setq to from)))) |
423 |
(dolist (ov (overlays-in from to)) |
(if hs-allow-nesting |
424 |
(when (overlay-get ov 'hs) |
(let (ov) |
425 |
(delete-overlay ov)))) |
(while (> to (setq from (next-overlay-change from))) |
426 |
|
(when (setq ov (hs-overlay-at from)) |
427 |
|
(setq from (overlay-end ov)) |
428 |
|
(delete-overlay ov)))) |
429 |
|
(dolist (ov (overlays-in from to)) |
430 |
|
(when (overlay-get ov 'hs) |
431 |
|
(delete-overlay ov))))) |
432 |
|
|
433 |
(defun hs-make-overlay (b e kind &optional b-offset e-offset) |
(defun hs-make-overlay (b e kind &optional b-offset e-offset) |
434 |
"Return a new overlay in region defined by B and E with type KIND. |
"Return a new overlay in region defined by B and E with type KIND. |
543 |
;; `q' is the point at the end of the block |
;; `q' is the point at the end of the block |
544 |
(progn (hs-forward-sexp mdata 1) |
(progn (hs-forward-sexp mdata 1) |
545 |
(end-of-line) |
(end-of-line) |
546 |
(point)))) |
(point))) |
547 |
|
ov) |
548 |
(when (and (< p (point)) (> (count-lines p q) 1)) |
(when (and (< p (point)) (> (count-lines p q) 1)) |
549 |
(hs-discard-overlays p q) |
(cond ((and hs-allow-nesting (setq ov (hs-overlay-at p))) |
550 |
|
(delete-overlay ov)) |
551 |
|
((not hs-allow-nesting) |
552 |
|
(hs-discard-overlays p q))) |
553 |
(hs-make-overlay p q 'code (- pure-p p))) |
(hs-make-overlay p q 'code (- pure-p p))) |
554 |
(goto-char (if end q (min p pure-p))))))) |
(goto-char (if end q (min p pure-p))))))) |
555 |
|
|
|
(defun hs-safety-is-job-n () |
|
|
"Warn if `buffer-invisibility-spec' does not contain symbol `hs'." |
|
|
(unless (and (listp buffer-invisibility-spec) |
|
|
(assq 'hs buffer-invisibility-spec)) |
|
|
(message "Warning: `buffer-invisibility-spec' does not contain hs!!") |
|
|
(sit-for 2))) |
|
|
|
|
556 |
(defun hs-inside-comment-p () |
(defun hs-inside-comment-p () |
557 |
"Return non-nil if point is inside a comment, otherwise nil. |
"Return non-nil if point is inside a comment, otherwise nil. |
558 |
Actually, return a list containing the buffer position of the start |
Actually, return a list containing the buffer position of the start |
666 |
(setq minp (1+ (point))) |
(setq minp (1+ (point))) |
667 |
(funcall hs-forward-sexp-func 1) |
(funcall hs-forward-sexp-func 1) |
668 |
(setq maxp (1- (point)))) |
(setq maxp (1- (point)))) |
669 |
(hs-discard-overlays minp maxp) ; eliminate weirdness |
(unless hs-allow-nesting |
670 |
|
(hs-discard-overlays minp maxp)) |
671 |
(goto-char minp) |
(goto-char minp) |
672 |
(while (progn |
(while (progn |
673 |
(forward-comment (buffer-size)) |
(forward-comment (buffer-size)) |
677 |
(hs-hide-level-recursive (1- arg) minp maxp) |
(hs-hide-level-recursive (1- arg) minp maxp) |
678 |
(goto-char (match-beginning hs-block-start-mdata-select)) |
(goto-char (match-beginning hs-block-start-mdata-select)) |
679 |
(hs-hide-block-at-point t))) |
(hs-hide-block-at-point t))) |
|
(hs-safety-is-job-n) |
|
680 |
(goto-char maxp)) |
(goto-char maxp)) |
681 |
|
|
682 |
(defmacro hs-life-goes-on (&rest body) |
(defmacro hs-life-goes-on (&rest body) |
690 |
|
|
691 |
(put 'hs-life-goes-on 'edebug-form-spec '(&rest form)) |
(put 'hs-life-goes-on 'edebug-form-spec '(&rest form)) |
692 |
|
|
693 |
|
(defun hs-overlay-at (position) |
694 |
|
"Return hideshow overlay at POSITION, or nil if none to be found." |
695 |
|
(let ((overlays (overlays-at position)) |
696 |
|
ov found) |
697 |
|
(while (and (not found) (setq ov (car overlays))) |
698 |
|
(setq found (and (overlay-get ov 'hs) ov) |
699 |
|
overlays (cdr overlays))) |
700 |
|
found)) |
701 |
|
|
702 |
(defun hs-already-hidden-p () |
(defun hs-already-hidden-p () |
703 |
"Return non-nil if point is in an already-hidden block, otherwise nil." |
"Return non-nil if point is in an already-hidden block, otherwise nil." |
704 |
(save-excursion |
(save-excursion |
712 |
;; point is inside a block |
;; point is inside a block |
713 |
(goto-char (match-end 0))))) |
(goto-char (match-end 0))))) |
714 |
(end-of-line) |
(end-of-line) |
715 |
(let ((overlays (overlays-at (point))) |
(hs-overlay-at (point)))) |
|
(found nil)) |
|
|
(while (and (not found) (overlayp (car overlays))) |
|
|
(setq found (overlay-get (car overlays) 'hs) |
|
|
overlays (cdr overlays))) |
|
|
found))) |
|
716 |
|
|
717 |
(defun hs-c-like-adjust-block-beginning (initial) |
(defun hs-c-like-adjust-block-beginning (initial) |
718 |
"Adjust INITIAL, the buffer position after `hs-block-start-regexp'. |
"Adjust INITIAL, the buffer position after `hs-block-start-regexp'. |
736 |
(hs-life-goes-on |
(hs-life-goes-on |
737 |
(message "Hiding all blocks ...") |
(message "Hiding all blocks ...") |
738 |
(save-excursion |
(save-excursion |
739 |
(hs-discard-overlays (point-min) (point-max)) ; eliminate weirdness |
(unless hs-allow-nesting |
740 |
|
(hs-discard-overlays (point-min) (point-max))) |
741 |
(goto-char (point-min)) |
(goto-char (point-min)) |
742 |
(let ((count 0) |
(let ((count 0) |
743 |
(re (concat "\\(" |
(re (concat "\\(" |
765 |
(if (> (count-lines (car c-reg) (nth 1 c-reg)) 1) |
(if (> (count-lines (car c-reg) (nth 1 c-reg)) 1) |
766 |
(hs-hide-block-at-point t c-reg) |
(hs-hide-block-at-point t c-reg) |
767 |
(goto-char (nth 1 c-reg)))))) |
(goto-char (nth 1 c-reg)))))) |
768 |
(message "Hiding ... %d" (setq count (1+ count))))) |
(message "Hiding ... %d" (setq count (1+ count)))))) |
|
(hs-safety-is-job-n)) |
|
769 |
(beginning-of-line) |
(beginning-of-line) |
770 |
(message "Hiding all blocks ... done") |
(message "Hiding all blocks ... done") |
771 |
(run-hooks 'hs-hide-hook))) |
(run-hooks 'hs-hide-hook))) |
775 |
(interactive) |
(interactive) |
776 |
(hs-life-goes-on |
(hs-life-goes-on |
777 |
(message "Showing all blocks ...") |
(message "Showing all blocks ...") |
778 |
(hs-discard-overlays (point-min) (point-max)) |
(let ((hs-allow-nesting nil)) |
779 |
|
(hs-discard-overlays (point-min) (point-max))) |
780 |
(message "Showing all blocks ... done") |
(message "Showing all blocks ... done") |
781 |
(run-hooks 'hs-show-hook))) |
(run-hooks 'hs-show-hook))) |
782 |
|
|
795 |
(looking-at hs-block-start-regexp) |
(looking-at hs-block-start-regexp) |
796 |
(hs-find-block-beginning)) |
(hs-find-block-beginning)) |
797 |
(hs-hide-block-at-point end c-reg) |
(hs-hide-block-at-point end c-reg) |
|
(hs-safety-is-job-n) |
|
798 |
(run-hooks 'hs-hide-hook)))))) |
(run-hooks 'hs-hide-hook)))))) |
799 |
|
|
800 |
(defun hs-show-block (&optional end) |
(defun hs-show-block (&optional end) |
806 |
(hs-life-goes-on |
(hs-life-goes-on |
807 |
(or |
(or |
808 |
;; first see if we have something at the end of the line |
;; first see if we have something at the end of the line |
809 |
(catch 'eol-begins-hidden-region-p |
(let ((ov (hs-overlay-at (save-excursion (end-of-line) (point)))) |
810 |
(let ((here (point))) |
(here (point))) |
811 |
(dolist (ov (save-excursion (end-of-line) (overlays-at (point)))) |
(when ov |
812 |
(when (overlay-get ov 'hs) |
(goto-char |
813 |
(goto-char |
(cond (end (overlay-end ov)) |
814 |
(cond (end (overlay-end ov)) |
((eq 'comment (overlay-get ov 'hs)) here) |
815 |
((eq 'comment (overlay-get ov 'hs)) here) |
(t (+ (overlay-start ov) (overlay-get ov 'hs-b-offset))))) |
816 |
(t (+ (overlay-start ov) (overlay-get ov 'hs-b-offset))))) |
(delete-overlay ov) |
817 |
(delete-overlay ov) |
t)) |
|
(throw 'eol-begins-hidden-region-p t))) |
|
|
nil)) |
|
818 |
;; not immediately obvious, look for a suitable block |
;; not immediately obvious, look for a suitable block |
819 |
(let ((c-reg (hs-inside-comment-p)) |
(let ((c-reg (hs-inside-comment-p)) |
820 |
p q) |
p q) |
830 |
(when (and p q) |
(when (and p q) |
831 |
(hs-discard-overlays p q) |
(hs-discard-overlays p q) |
832 |
(goto-char (if end q (1+ p))))) |
(goto-char (if end q (1+ p))))) |
|
(hs-safety-is-job-n) |
|
833 |
(run-hooks 'hs-show-hook)))) |
(run-hooks 'hs-show-hook)))) |
834 |
|
|
835 |
(defun hs-hide-level (arg) |
(defun hs-hide-level (arg) |
841 |
(message "Hiding blocks ...") |
(message "Hiding blocks ...") |
842 |
(hs-hide-level-recursive arg (point-min) (point-max)) |
(hs-hide-level-recursive arg (point-min) (point-max)) |
843 |
(message "Hiding blocks ... done")) |
(message "Hiding blocks ... done")) |
|
(hs-safety-is-job-n) |
|
844 |
(run-hooks 'hs-hide-hook))) |
(run-hooks 'hs-hide-hook))) |
845 |
|
|
846 |
(defun hs-toggle-hiding () |
(defun hs-toggle-hiding () |