/[emacs]/emacs/lisp/progmodes/hideshow.el
ViewVC logotype

Diff of /emacs/lisp/progmodes/hideshow.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.56 by ttn, Wed Sep 14 00:16:25 2005 UTC revision 1.57 by ttn, Wed Sep 14 00:27:40 2005 UTC
# Line 6  Line 6 
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.
# Line 243  Line 243 
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
# Line 307  whitespace.  Case does not matter.") Line 306  whitespace.  Case does not matter.")
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
# Line 412  Note that `mode-line-format' is buffer-l Line 416  Note that `mode-line-format' is buffer-l
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.
# Line 532  and then further adjusted to be at the e Line 543  and then further adjusted to be at the e
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
# Line 658  Return point, or nil if original point w Line 666  Return point, or nil if original point w
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))
# Line 668  Return point, or nil if original point w Line 677  Return point, or nil if original point w
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)
# Line 682  and `case-fold-search' are both t." Line 690  and `case-fold-search' are both t."
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
# Line 695  and `case-fold-search' are both t." Line 712  and `case-fold-search' are both t."
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'.
# Line 724  If `hs-hide-comments-when-hiding-all' is Line 736  If `hs-hide-comments-when-hiding-all' is
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 "\\("
# Line 752  If `hs-hide-comments-when-hiding-all' is Line 765  If `hs-hide-comments-when-hiding-all' is
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)))
# Line 763  If `hs-hide-comments-when-hiding-all' is Line 775  If `hs-hide-comments-when-hiding-all' is
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    
# Line 782  Upon completion, point is repositioned a Line 795  Upon completion, point is repositioned a
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)
# Line 794  See documentation for functions `hs-hide Line 806  See documentation for functions `hs-hide
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)
# Line 820  See documentation for functions `hs-hide Line 830  See documentation for functions `hs-hide
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)
# Line 832  The hook `hs-hide-hook' is run; see `run Line 841  The hook `hs-hide-hook' is run; see `run
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 ()

Legend:
Removed from v.1.56  
changed lines
  Added in v.1.57

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26