/[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.50 by ttn, Fri Dec 24 02:05:30 2004 UTC revision 1.51 by ttn, Sun Dec 26 19:45:59 2004 UTC
# Line 5  Line 5 
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.
# Line 138  Line 138 
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  ;;  ;;
# Line 304  a block), `hs-hide-all', `hs-hide-block' Line 317  a block), `hs-hide-all', `hs-hide-block'
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    
# Line 388  Note that `mode-line-format' is buffer-l Line 419  Note that `mode-line-format' is buffer-l
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    
# Line 416  property of an overlay." Line 476  property of an overlay."
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."
# Line 453  Original match data is restored upon ret Line 498  Original match data is restored upon ret
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)
# Line 488  and then further adjusted to be at the e Line 534  and then further adjusted to be at the e
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 ()
# Line 612  Return point, or nil if original point w Line 657  Return point, or nil if original point w
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))
# Line 678  If `hs-hide-comments-when-hiding-all' is Line 723  If `hs-hide-comments-when-hiding-all' is
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 "\\("
# Line 717  If `hs-hide-comments-when-hiding-all' is Line 762  If `hs-hide-comments-when-hiding-all' is
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    
# Line 755  See documentation for functions `hs-hide Line 800  See documentation for functions `hs-hide
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))
# Line 771  See documentation for functions `hs-hide Line 816  See documentation for functions `hs-hide
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))))

Legend:
Removed from v.1.50  
changed lines
  Added in v.1.51

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