aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1997-05-29 05:23:39 +0000
committerRichard M. Stallman1997-05-29 05:23:39 +0000
commit88039caa2b0561b8bee4d0381604a9c78a1dffa5 (patch)
tree41c7e5f88742471bcb70a437439d35e73ed80c3d
parentf188b3c4b8facf2ba99783381e3ebf3a58c2f28b (diff)
downloademacs-88039caa2b0561b8bee4d0381604a9c78a1dffa5.tar.gz
emacs-88039caa2b0561b8bee4d0381604a9c78a1dffa5.zip
(hs-special-modes-alist): Include also the
comment regexp in the alist. This is needed for modes like c++ where the comment beginning regexp is not easy to determine from the syntax table. Include ADJUST-BLOCK-BEGINNING in the alist. (hs-hide-comments-when-hiding-all): Add autoload cookie. (hs-show-hidden-short-form): (hs-adjust-block-beginning): New variables. Comment out `hs-menu-bar' as XEmacs support was removed. (hs-c-end-regexp): Remove variable, obsoleted by the rewrite of `hs-inside-comment-p'. (hs-discard-overlays): No need to test if we are inside the overlay, we surely are since we got the overlay using `overlays-at'. (hs-hide-block-at-point): Rewritten to use the new variables. Use only one parameter to specify the comment. (hs-show-block-at-point): No need for the COMMENT-REG parameter. (hs-safety-is-job-n): Correct typo. (hs-hide-initial-comment-block): Add ^L to the chars to skip. Take into account `hs-show-hidden-short-form' when testing. (hs-inside-single-line-comment-p): Function deleted, obsoleted by the rewrite of `hs-inside-comment-p'. (hs-inside-comment-p): Rewritten from scratch. Semantics changed when returning non-nil. We can be inside a comment, but that comment might not be hidable (the car of the return value should be non-nil to be hidable). (hs-grok-mode-type): Rewrite to be more understandable. `hs-c-end-regexp' does not exist any more. Initialize `hs-c-start-regexp' from the alist if specified there. Initialize `hs-adjust-block-beginning'. (hs-find-block-beginning): Rewritten to be able to deal with the situation when a block beginning spans multiple lines and the point is on one of those lines. (hs-already-hidden-p): Look first if we are inside a comment or a block, go to their end and look there for the overlays. (java-hs-adjust-block-beginning): New function. (hs-hide-all): Hide a comment block only if `hs-inside-comment-p' says is hidable. (hs-hide-block): Simplify. Handle properly the result of `hs-inside-comment-p'. (hs-show-block): Likewise. (hs-minor-mode): Doc string fixes. Make `hs-adjust-block-beginning' buffer local. Delete making `hs-c-end-regexp' buffer local as it was deleted.
-rw-r--r--lisp/progmodes/hideshow.el499
1 files changed, 335 insertions, 164 deletions
diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el
index 826b7fd219b..45bc49a94b8 100644
--- a/lisp/progmodes/hideshow.el
+++ b/lisp/progmodes/hideshow.el
@@ -87,9 +87,50 @@ Values other than these four will be interpreted as `signal'.")
87;;;#autoload 87;;;#autoload
88(defvar hs-special-modes-alist 88(defvar hs-special-modes-alist
89 '((c-mode "{" "}") 89 '((c-mode "{" "}")
90 (c++-mode "{" "}") 90 (c++-mode "{" "}" "/[*/]")
91 (java-mode "\\(\\(public\\|private\\|protected\\|static\\|\\s-\\)+\\([a-zA-Z0-9_:]+[ \t]+\\)\\([a-zA-Z0-9_:]+\\)[ \t]*([^)]*)[ \t\n]*\\([ \t\n]throws[ \t]+[^{]+\\)*[ \t]*\\){" "}" java-hs-forward-sexp)) 91 (java-mode "\\(\\(\\([ \t]*\\(\\(public\\|private\\|protected\\|abstract\\|static\\|\\final\\)[ \t\n]+\\)+\\(synchronized[ \t\n]*\\)?[a-zA-Z0-9_:]+[ \t\n]*\\(\\[[ \t\n]*\\][ \t\n]*\\)?\\([a-zA-Z0-9_:]+[ \t\n]*\\)([^)]*)\\([ \n\t]+throws[ \t\n][^{]+\\)?\\)\\|\\([ \t]*static[^{]*\\)\\)[ \t\n]*{\\)" "}" "/[*/]" java-hs-forward-sexp java-hs-adjust-block-beginning))
92 "*Alist of the form (MODE START-RE END-RE FORWARD-SEXP-FUNC). 92; I tested the java regexp using the following:
93;(defvar hsj-public)
94;(defvar hsj-syncronised)
95;(defvar hsj-type)
96;(defvar hsj-fname)
97;(defvar hsj-par)
98;(defvar hsj-throws)
99;(defvar hsj-static)
100
101;(setq hsj-public "[ \t]*\\(\\(public\\|private\\|protected\\|abstract\\|static\\|\\final\\)[ \t\n]+\\)+")
102;(setq hsj-syncronised "\\(synchronized[ \t\n]*\\)?")
103;(setq hsj-type "[a-zA-Z0-9_:]+[ \t\n]*\\(\\[[ \t\n]*\\][ \t\n]*\\)?")
104;(setq hsj-fname "\\([a-zA-Z0-9_:]+[ \t\n]*\\)")
105;(setq hsj-par "([^)]*)")
106;(setq hsj-throws "\\([ \n\t]+throws[ \t\n][^{]+\\)?")
107
108;(setq hsj-static "[ \t]*static[^{]*")
109
110
111;(setq hs-block-start-regexp (concat
112; "\\("
113; "\\("
114; "\\("
115; hsj-public
116; hsj-syncronised
117; hsj-type
118; hsj-fname
119; hsj-par
120; hsj-throws
121; "\\)"
122; "\\|"
123; "\\("
124; hsj-static
125; "\\)"
126; "\\)"
127; "[ \t\n]*{"
128; "\\)"
129; ))
130
131 "*Alist for initializing the hideshow variables for different modes.
132It has the form
133(MODE START-RE END-RE COMMENT-START-RE FORWARD-SEXP-FUNC ADJUST-BEG-FUNC).
93If present, hideshow will use these values for the start and end regexps, 134If present, hideshow will use these values for the start and end regexps,
94respectively. Since Algol-ish languages do not have single-character 135respectively. Since Algol-ish languages do not have single-character
95block delimiters, the function `forward-sexp' which is used by hideshow 136block delimiters, the function `forward-sexp' which is used by hideshow
@@ -102,9 +143,15 @@ more values, use
102 143
103For example: 144For example:
104 145
105\t(pushnew '(simula-mode \"begin\" \"end\" simula-next-statement) 146\t(pushnew '(simula-mode \"begin\" \"end\" \"!\" simula-next-statement)
106\t hs-special-modes-alist :test 'equal) 147\t hs-special-modes-alist :test 'equal)
107 148
149See the documentation for `hs-adjust-block-beginning' to see what
150is the use of ADJUST-BEG-FUNC.
151
152If any of those is left nil, hideshow will try to guess some values, see
153`hs-grok-mode-type' for this.
154
108Note that the regexps should not contain leading or trailing whitespace.") 155Note that the regexps should not contain leading or trailing whitespace.")
109 156
110(defvar hs-minor-mode-hook 'hs-hide-initial-comment-block 157(defvar hs-minor-mode-hook 'hs-hide-initial-comment-block
@@ -122,6 +169,49 @@ These commands include `hs-show-all', `hs-show-block' and `hs-show-region'.")
122(defvar hs-minor-mode-prefix "\C-c" 169(defvar hs-minor-mode-prefix "\C-c"
123 "*Prefix key to use for hideshow commands in hideshow minor mode.") 170 "*Prefix key to use for hideshow commands in hideshow minor mode.")
124 171
172;;;#autoload
173(defvar hs-hide-comments-when-hiding-all t
174 "Hide the comments too when you do an `hs-hide-all'." )
175
176;;;#autoload
177(defvar hs-show-hidden-short-form t
178 "Leave only the first line visible in a hidden block.
179If t only the first line is visible when a block is in the hidden state,
180else both the first line and the last line are showed. Also if t and
181`hs-adjust-block-beginning' is set, it is used also.
182
183An example of how this works: (in c-mode)
184original:
185
186/* My function main
187 some more stuff about main
188*/
189int
190main(void)
191{
192 int x=0;
193 return 0;
194}
195
196
197hidden and hs-show-hidden-short-form is nil
198/* My function main...
199*/
200int
201main(void)
202{...
203}
204
205hidden and hs-show-hidden-short-form is t
206/* My function main...
207int
208main(void)
209{ ...
210
211
212The latest has the disadvantage of not being symetrical, but it saves
213screen lines ...
214")
125 215
126;;;---------------------------------------------------------------------------- 216;;;----------------------------------------------------------------------------
127;;; internal variables 217;;; internal variables
@@ -133,18 +223,14 @@ Use the command `hs-minor-mode' to toggle this variable.")
133(defvar hs-minor-mode-map nil 223(defvar hs-minor-mode-map nil
134 "Mode map for hideshow minor mode.") 224 "Mode map for hideshow minor mode.")
135 225
136(defvar hs-menu-bar nil 226;(defvar hs-menu-bar nil
137 "Menu bar for hideshow minor mode (Xemacs only).") 227; "Menu bar for hideshow minor mode (Xemacs only).")
138 228
139(defvar hs-c-start-regexp nil 229(defvar hs-c-start-regexp nil
140 "Regexp for beginning of comments. 230 "Regexp for beginning of comments.
141Differs from mode-specific comment regexps in that 231Differs from mode-specific comment regexps in that
142surrounding whitespace is stripped.") 232surrounding whitespace is stripped.")
143 233
144(defvar hs-c-end-regexp nil
145 "Regexp for end of comments.
146See `hs-c-start-regexp'.")
147
148(defvar hs-block-start-regexp nil 234(defvar hs-block-start-regexp nil
149 "Regexp for beginning of block.") 235 "Regexp for beginning of block.")
150 236
@@ -159,8 +245,24 @@ either `(' or `)' -- `hs-forward-sexp-func' would just be `forward-sexp'.
159For other modes such as simula, a more specialized function 245For other modes such as simula, a more specialized function
160is necessary.") 246is necessary.")
161 247
162(defvar hs-hide-comments-when-hiding-all t 248(defvar hs-adjust-block-beginning nil
163 "Hide the comments too when you do an `hs-hide-all'." ) 249 "Function used to tweak the block beginning.
250It has effect only if `hs-show-hidden-short-form' is t. The block it
251is hidden from the point returned by this function, as opposed to
252hiding it from the point returned when searching
253`hs-block-start-regexp'. In c-like modes, if we wish to also hide the
254curly braces (if you think they occupy too much space on the screen),
255this function should return the starting point (at the end of line) of
256the hidden region.
257
258It is called with a single argument ARG which is the the position in
259buffer after the block beginning.
260
261It should return the position from where we should start hiding.
262
263It should not move the point.
264
265See `java-hs-adjust-block-beginning' for an example of using this.")
164 266
165;(defvar hs-emacs-type 'fsf 267;(defvar hs-emacs-type 'fsf
166; "Used to support both Emacs and Xemacs.") 268; "Used to support both Emacs and Xemacs.")
@@ -175,7 +277,7 @@ is necessary.")
175;;;---------------------------------------------------------------------------- 277;;;----------------------------------------------------------------------------
176;;; support funcs 278;;; support funcs
177 279
178;; snarfed from noutline.el; 280;; snarfed from outline.el;
179(defun hs-flag-region (from to flag) 281(defun hs-flag-region (from to flag)
180 "Hides or shows lines from FROM to TO, according to FLAG. 282 "Hides or shows lines from FROM to TO, according to FLAG.
181If FLAG is nil then text is shown, while if FLAG is t the text is hidden." 283If FLAG is nil then text is shown, while if FLAG is t the text is hidden."
@@ -203,67 +305,79 @@ If FLAG is nil then text is shown, while if FLAG is t the text is hidden."
203 (while overlays 305 (while overlays
204 (let ((o (car overlays))) 306 (let ((o (car overlays)))
205 (if (eq (overlay-get o prop) value) 307 (if (eq (overlay-get o prop) value)
206 (if (or 308 (delete-overlay o)))
207 (and (> (overlay-end o) beg) (< (overlay-end o) end))
208 (and (< (overlay-start o) beg) (< (overlay-start o) end)))
209 (delete-overlay o))))
210 (setq overlays (cdr overlays)))) 309 (setq overlays (cdr overlays))))
211 (goto-char (next-overlay-change (point)))))) 310 (goto-char (next-overlay-change (point))))))
212 311
213(defun hs-hide-block-at-point (&optional end comment c-reg) 312(defun hs-hide-block-at-point (&optional end comment-reg)
214 "Hide block iff on block beginning, optional END means reposition at end. 313 "Hide block iff on block beginning, optional END means reposition at end.
215COMMENT true means that it should hide a comment block, C-REG is a list 314COMMENT-REG is a list of the form (BEGIN . END) and specifies the limits
216of the form (BEGIN . END) and specifies the limits of the comment." 315of the comment, or nil if the block is not a comment."
217 (if comment 316 (if comment-reg
218 (let ((reg (if c-reg c-reg (hs-inside-comment-p)))) 317 (progn
219 (goto-char (nth 1 reg)) 318 ;; goto the end of line at the end of the comment
220 (forward-line -1) 319 (goto-char (nth 1 comment-reg))
320 (unless hs-show-hidden-short-form (forward-line -1))
221 (end-of-line) 321 (end-of-line)
222 (hs-flag-region (car reg) (point) t) 322 (hs-flag-region (car comment-reg) (point) t)
223 (goto-char (if end (nth 1 reg) (car reg))) 323 (goto-char (if end (nth 1 comment-reg) (car comment-reg))))
224 )
225 (if (looking-at hs-block-start-regexp) 324 (if (looking-at hs-block-start-regexp)
226 (let* ((p (point)) 325 (let* ((p ;; p is the point at the end of the block beginning
326 (if (and hs-show-hidden-short-form
327 hs-adjust-block-beginning)
328 ;; we need to adjust the block beginning
329 (funcall hs-adjust-block-beginning (match-end 0))
330 (match-end 0)))
331 ;; q is the point at the end of the block
227 (q (progn (funcall hs-forward-sexp-func 1) (point)))) 332 (q (progn (funcall hs-forward-sexp-func 1) (point))))
228 (forward-line -1) (end-of-line) 333 ;; position the point so we can call `hs-flag-region'
229 (if (and (< p (point)) (> (count-lines p q) 1)) 334 (unless hs-show-hidden-short-form (forward-line -1))
230 (hs-flag-region p (point) t)) 335 (end-of-line)
231 (goto-char (if end q p)))))) 336 (if (and (< p (point)) (> (count-lines p q)
232 337 (if hs-show-hidden-short-form 1 2)))
233(defun hs-show-block-at-point (&optional end) 338 (hs-flag-region p (point) t))
234 "Show block iff on block beginning. Optional END means reposition at end." 339 (goto-char (if end q p))))))
235 (if (looking-at hs-block-start-regexp) 340
236 (let* ((p (point)) 341(defun hs-show-block-at-point (&optional end comment-reg)
237 (q 342 "Show block iff on block beginning. Optional END means reposition at end.
238 (condition-case error ; probably unbalanced paren 343COMMENT-REG is a list of the forme (BEGIN . END) and specifies the limits
239 (progn 344of the comment. It should be nil when hiding a block."
240 (funcall hs-forward-sexp-func 1) 345 (if comment-reg
241 (point)) 346 (when (car comment-reg)
242 (error 347 (hs-flag-region (car comment-reg) (nth 1 comment-reg) nil)
243 (cond 348 (goto-char (if end (nth 1 comment-reg) (car comment-reg))))
244 ((eq hs-unbalance-handler-method 'ignore) 349 (if (looking-at hs-block-start-regexp)
245 ;; just ignore this block 350 (let* ((p (point))
246 (point)) 351 (q
247 ((eq hs-unbalance-handler-method 'top-level) 352 (condition-case error ; probably unbalanced paren
248 ;; try to get out of rat's nest and expose the whole func 353 (progn
249 (if (/= (current-column) 0) (beginning-of-defun)) 354 (funcall hs-forward-sexp-func 1)
250 (setq p (point)) 355 (point))
251 (re-search-forward (concat "^" hs-block-start-regexp) 356 (error
252 (point-max) t 2) 357 (cond
253 (point)) 358 ((eq hs-unbalance-handler-method 'ignore)
254 ((eq hs-unbalance-handler-method 'next-line) 359 ;; just ignore this block
255 ;; assumption is that user knows what s/he's doing 360 (point))
256 (beginning-of-line) (setq p (point)) 361 ((eq hs-unbalance-handler-method 'top-level)
257 (end-of-line 2) (point)) 362 ;; try to get out of rat's nest and expose the whole func
258 (t 363 (if (/= (current-column) 0) (beginning-of-defun))
259 ;; pass error through -- this applies to `signal', too 364 (setq p (point))
260 (signal (car error) (cdr error)))))))) 365 (re-search-forward (concat "^" hs-block-start-regexp)
261 (hs-flag-region p q nil) 366 (point-max) t 2)
262 (goto-char (if end (1+ (point)) p))))) 367 (point))
368 ((eq hs-unbalance-handler-method 'next-line)
369 ;; assumption is that user knows what s/he's doing
370 (beginning-of-line) (setq p (point))
371 (end-of-line 2) (point))
372 (t
373 ;; pass error through -- this applies to `signal', too
374 (signal (car error) (cdr error))))))))
375 (hs-flag-region p q nil)
376 (goto-char (if end (1+ (point)) p))))))
263 377
264(defun hs-safety-is-job-n () 378(defun hs-safety-is-job-n ()
265 "Warn `buffer-invisibility-spec' does not contain hs." 379 "Warn `buffer-invisibility-spec' does not contain hs."
266 (if (or buffer-invisibility-spec (assq hs buffer-invisibility-spec) ) 380 (if (or buffer-invisibility-spec (assq 'hs buffer-invisibility-spec) )
267 nil 381 nil
268 (message "Warning: `buffer-invisibility-spec' does not contain hs!!") 382 (message "Warning: `buffer-invisibility-spec' does not contain hs!!")
269 (sit-for 2))) 383 (sit-for 2)))
@@ -276,82 +390,122 @@ file beginning, so if you have huge RCS logs you won't see them!"
276 (let ((p (point)) 390 (let ((p (point))
277 c-reg) 391 c-reg)
278 (goto-char (point-min)) 392 (goto-char (point-min))
279 (skip-chars-forward " \t\n") 393 (skip-chars-forward " \t\n^L")
280 (setq c-reg (hs-inside-comment-p)) 394 (setq c-reg (hs-inside-comment-p))
281 (if (and c-reg (> (count-lines (car c-reg) (nth 1 c-reg)) 2)) 395 ;; see if we have enough comment lines to hide
396 (if (and c-reg (> (count-lines (car c-reg) (nth 1 c-reg))
397 (if hs-show-hidden-short-form 1 2)))
282 (hs-hide-block) 398 (hs-hide-block)
283 (goto-char p)))) 399 (goto-char p))))
284 400
285(defun hs-inside-single-line-comment-p ()
286 "Look to see if we are on a single line comment."
287 (save-excursion
288 (beginning-of-line)
289 (looking-at (concat "^[ \t]*" hs-c-start-regexp))))
290
291(defun hs-inside-comment-p () 401(defun hs-inside-comment-p ()
292 "Returns non-nil if point is inside a comment, otherwise nil. 402 "Returns non-nil if point is inside a comment, otherwise nil.
293Actually, returns a list containing the buffer position of the start 403Actually, returns a list containing the buffer position of the start
294and the end of the comment." 404and the end of the comment. A comment block can be hided only if on its
295 (save-excursion 405starting line there are only white spaces preceding the actual comment
296 (let ((p (point)) 406beginning, if we are inside of a comment but this condition is not
297 q 407we return a list having a nil as its car and the end of comment position
298 p-aux) 408as cdr."
299 (if (string= comment-end "") ; single line 409 (save-excursion
300 (if (not (hs-inside-single-line-comment-p)) 410 ;; the idea is to look backwards for a comment start regexp, do a
301 nil 411 ;; forward comment, and see if we are inside, then extend extend
302 ;;find-beginning-of-the-chained-single-line-comments 412 ;; forward and backward as long as we have comments
303 (beginning-of-line) 413 (let ((q (point)))
304 (forward-comment (- (buffer-size))) 414 (when (or (looking-at hs-c-start-regexp)
305 (skip-chars-forward " \t\n") 415 (re-search-backward hs-c-start-regexp (point-min) t))
306 (beginning-of-line) 416 (forward-comment (- (buffer-size)))
307 (setq q (point)) 417 (skip-chars-forward " \t\n ")
308 (goto-char p) 418 (let ((p (point))
309 ;;find-end-of-the-chained-single-line-comments 419 (not-hidable nil))
310 (forward-comment (buffer-size)) 420 (beginning-of-line)
311 (skip-chars-backward " \t\n") 421 (unless (looking-at (concat "[ \t]*" hs-c-start-regexp))
312 (list q (point))) 422 ;; we are in this situation: (example)
313 (re-search-forward hs-c-end-regexp (point-max) 1) 423 ;; (defun bar ()
314 (forward-comment (buffer-size)) 424 ;; (foo)
315 (skip-chars-backward " \t\n") 425 ;; ) ; comment
316 (end-of-line) 426 ;; ^
317 (setq q (point)) 427 ;; the point was here before doing (beginning-of-line)
318 (forward-comment (- 0 (buffer-size))) 428 ;; here we should advance till the next comment which
319 (re-search-forward hs-c-start-regexp (point-max) 1) 429 ;; eventually has only white spaces preceding it on the same
320 (setq p-aux (- (point) (length comment-start))) 430 ;; line
321 (if (and (>= p-aux 0) (< p-aux p)) 431 (goto-char p)
322 (list (match-beginning 0) q)))))) 432 (forward-comment 1)
433 (skip-chars-forward " \t\n ")
434 (setq p (point))
435 (while (and (< (point) q)
436 (> (point) p)
437 (not (looking-at hs-c-start-regexp)))
438 (setq p (point)) ;; use this to avoid an infinit cycle.
439 (forward-comment 1)
440 (skip-chars-forward " \t\n "))
441 (if (or (not (looking-at hs-c-start-regexp))
442 (> (point) q))
443 ;; we cannot hide this comment block
444 (setq not-hidable t)))
445 ;; goto the end of the comment
446 (forward-comment (buffer-size))
447 (skip-chars-backward " \t\n ")
448 (end-of-line)
449 (if (>= (point) q)
450 (list (if not-hidable nil p) (point))))))))
323 451
324(defun hs-grok-mode-type () 452(defun hs-grok-mode-type ()
325 "Setup variables for new buffers where applicable." 453 "Setup variables for new buffers where applicable."
326 (if (and (boundp 'comment-start) 454 (when (and (boundp 'comment-start)
327 (boundp 'comment-end)) 455 (boundp 'comment-end))
328 (progn 456 (let ((lookup (assoc major-mode hs-special-modes-alist)))
329 (setq hs-c-start-regexp (regexp-quote comment-start)) 457 (setq hs-block-start-regexp (or (nth 1 lookup) "\\s\(")
330 (if (string-match " +$" hs-c-start-regexp) 458 hs-block-end-regexp (or (nth 2 lookup) "\\s\)")
331 (setq hs-c-start-regexp 459 hs-c-start-regexp (or (nth 3 lookup)
332 (substring hs-c-start-regexp 0 (1- (match-end 0))))) 460 (let ((c-start-regexp
333 (setq hs-c-end-regexp (if (string= "" comment-end) "\n" 461 (regexp-quote comment-start)))
334 (regexp-quote comment-end))) 462 (if (string-match " +$" c-start-regexp)
335 (if (string-match "^ +" hs-c-end-regexp) 463 (substring c-start-regexp 0 (1- (match-end 0)))
336 (setq hs-c-end-regexp 464 c-start-regexp)))
337 (substring hs-c-end-regexp (match-end 0)))) 465 hs-forward-sexp-func (or (nth 4 lookup) 'forward-sexp)
338 (let ((lookup (assoc major-mode hs-special-modes-alist))) 466 hs-adjust-block-beginning (nth 5 lookup)))))
339 (setq hs-block-start-regexp (or (nth 1 lookup) "\\s\(")
340 hs-block-end-regexp (or (nth 2 lookup) "\\s\)")
341 hs-forward-sexp-func (or (nth 3 lookup) 'forward-sexp))))))
342 467
343(defun hs-find-block-beginning () 468(defun hs-find-block-beginning ()
344 "Repositions point at block-start. 469 "Repositions point at block-start.
345Return point, or nil if top-level." 470Return point, or nil if top-level."
346 (let (done 471 (let (done
472 (try-again t)
347 (here (point)) 473 (here (point))
348 (both-regexps (concat "\\(" hs-block-start-regexp "\\)\\|\\(" 474 (both-regexps (concat "\\(" hs-block-start-regexp "\\)\\|\\("
349 hs-block-end-regexp "\\)"))) 475 hs-block-end-regexp "\\)")))
476 (beginning-of-line)
477 ;; A block beginning can span on multiple lines, if the point
478 ;; is on one of those lines, trying a regexp search from
479 ;; that point would fail to find the block beginning, so we look
480 ;; backwards for the block beginning, or a block end.
481 (while try-again
482 (setq try-again nil)
483 (when (re-search-backward both-regexps (point-min) t)
484 (if (match-beginning 1) ; found a block beginning
485 (if (save-match-data (hs-inside-comment-p))
486 ;;but it was inside a comment, so we have to look for
487 ;;it again
488 (setq try-again t)
489 ;; that's what we were looking for
490 (setq done (match-beginning 0)))
491 ;; we found a block end, look to see if we were on a block
492 ;; beginning when we started
493 (if (and
494 (re-search-forward hs-block-start-regexp (point-max) t)
495 (>= here (match-beginning 0)) (< here (match-end 0)))
496 (setq done (match-beginning 0))))))
497 (goto-char here)
350 (while (and (not done) 498 (while (and (not done)
499 ;; This had problems because the regexp can match something
500 ;; inside of a comment!
501 ;; Since inside a comment we can have incomplete sexps
502 ;; this would have signaled an error.
503 (or (forward-comment (-(buffer-size))) t); `or' is a hack to
504 ; make it return t
351 (re-search-backward both-regexps (point-min) t)) 505 (re-search-backward both-regexps (point-min) t))
352 (if (match-beginning 1) ; start of start-regexp 506 (if (match-beginning 1) ; start of start-regexp
353 (setq done (match-beginning 1)) 507 (setq done (match-beginning 0))
354 (goto-char (match-end 2)) ; end of end-regexp 508 (goto-char (match-end 0)) ; end of end-regexp
355 (funcall hs-forward-sexp-func -1))) 509 (funcall hs-forward-sexp-func -1)))
356 (goto-char (or done here)) 510 (goto-char (or done here))
357 done)) 511 done))
@@ -361,8 +515,16 @@ Return point, or nil if top-level."
361 (list 'if 'hs-minor-mode (cons 'progn body))) 515 (list 'if 'hs-minor-mode (cons 'progn body)))
362 516
363(defun hs-already-hidden-p () 517(defun hs-already-hidden-p ()
364 "Return non-nil if point is in an already-hidden block otherwise nil." 518 "Return non-nil if point is in an already-hidden block, otherwise nil."
365 (save-excursion 519 (save-excursion
520 (let ((c-reg (hs-inside-comment-p)))
521 (if (and c-reg (nth 0 c-reg))
522 ;; point is inside a comment, and that comment is hidable
523 (goto-char (nth 0 c-reg))
524 (if (and (not c-reg) (hs-find-block-beginning)
525 (looking-at hs-block-start-regexp))
526 ;; point is inside a block
527 (goto-char (match-end 0)))))
366 (end-of-line) 528 (end-of-line)
367 (let ((overlays (overlays-at (point))) 529 (let ((overlays (overlays-at (point)))
368 (found nil)) 530 (found nil))
@@ -382,6 +544,17 @@ Return point, or nil if top-level."
382 (forward-sexp 1)) 544 (forward-sexp 1))
383 (forward-sexp 1)))) 545 (forward-sexp 1))))
384 546
547(defun java-hs-adjust-block-beginning (arg)
548 "Function to be assigned to `hs-adjust-block-beginning'.
549Arg is a position in buffer just after {. This goes back to the end of
550the function header. The purpose is to save some space on the screen
551when displaying hidden blocks."
552 (save-excursion
553 (goto-char arg)
554 (forward-char -1)
555 (forward-comment (- (buffer-size)))
556 (point)))
557
385;;;---------------------------------------------------------------------------- 558;;;----------------------------------------------------------------------------
386;;; commands 559;;; commands
387 560
@@ -398,7 +571,8 @@ If `hs-hide-comments-when-hiding-all' is t also hides the comments."
398 (hs-flag-region (point-min) (point-max) nil) ; eliminate weirdness 571 (hs-flag-region (point-min) (point-max) nil) ; eliminate weirdness
399 (goto-char (point-min)) 572 (goto-char (point-min))
400 (if hs-hide-comments-when-hiding-all 573 (if hs-hide-comments-when-hiding-all
401 (let ((count 0) 574 (let (c-reg
575 (count 0)
402 (block-and-comment-re ;; this should match 576 (block-and-comment-re ;; this should match
403 (concat "\\(^" ;; the block beginning and comment start 577 (concat "\\(^" ;; the block beginning and comment start
404 hs-block-start-regexp 578 hs-block-start-regexp
@@ -411,14 +585,13 @@ If `hs-hide-comments-when-hiding-all' is t also hides the comments."
411 (message "Hiding ... %d" (setq count (1+ count)))) 585 (message "Hiding ... %d" (setq count (1+ count))))
412 ;;found a comment 586 ;;found a comment
413 (setq c-reg (hs-inside-comment-p)) 587 (setq c-reg (hs-inside-comment-p))
414 (if c-reg 588 (if (and c-reg (car c-reg))
415 (progn 589 (if (> (count-lines (car c-reg) (nth 1 c-reg))
416 (goto-char (nth 1 c-reg)) 590 (if hs-show-hidden-short-form 1 2))
417 (if (> (count-lines (car c-reg) (nth 1 c-reg)) 2) 591 (progn
418 (progn 592 (hs-hide-block-at-point t c-reg)
419 (hs-hide-block-at-point t t c-reg) 593 (message "Hiding ... %d" (setq count (1+ count))))
420 (message "Hiding ... %d" 594 (goto-char (nth 1 c-reg)))))))
421 (setq count (1+ count))))))))))
422 (let ((count 0) 595 (let ((count 0)
423 (top-level-re (concat "^" hs-block-start-regexp))) 596 (top-level-re (concat "^" hs-block-start-regexp)))
424 (while 597 (while
@@ -446,48 +619,39 @@ See documentation for `run-hooks'."
446 619
447(defun hs-hide-block (&optional end) 620(defun hs-hide-block (&optional end)
448 "Selects a block and hides it. 621 "Selects a block and hides it.
449With prefix arg, reposition at end. Block is defined as a sexp for 622With prefix arg, reposition at end. Block is defined as a sexp for
450lispish modes, mode-specific otherwise. Comments are blocks, too. 623lispish modes, mode-specific otherwise. Comments are blocks, too.
451Upon completion, point is at repositioned and the normal hook 624Upon completion, point is at repositioned and the normal hook
452`hs-hide-hook' is run. See documentation for `run-hooks'." 625`hs-hide-hook' is run. See documentation for `run-hooks'."
453 (interactive "P") 626 (interactive "P")
454 (hs-life-goes-on 627 (hs-life-goes-on
455 (let ((c-reg (hs-inside-comment-p))) 628 (let ((c-reg (hs-inside-comment-p)))
456 (if c-reg 629 (cond
457 (cond 630 ((and c-reg (or (null (nth 0 c-reg))
458 ((<= (count-lines (car c-reg) (nth 1 c-reg)) 2) 631 (<= (count-lines (car c-reg) (nth 1 c-reg))
632 (if hs-show-hidden-short-form 1 2))))
459 (message "Not enough comment lines to hide!")) 633 (message "Not enough comment lines to hide!"))
460 (t 634 ((or c-reg (looking-at hs-block-start-regexp)
461 (goto-char (nth 1 c-reg))
462 (hs-hide-block-at-point end t c-reg)
463 (hs-safety-is-job-n)
464 (run-hooks 'hs-hide-hook)))
465 (if (or (looking-at hs-block-start-regexp)
466 (hs-find-block-beginning)) 635 (hs-find-block-beginning))
467 (progn 636 (hs-hide-block-at-point end c-reg)
468 (hs-hide-block-at-point end) 637 (hs-safety-is-job-n)
469 (hs-safety-is-job-n) 638 (run-hooks 'hs-hide-hook))))))
470 (run-hooks 'hs-hide-hook)))))))
471 639
472(defun hs-show-block (&optional end) 640(defun hs-show-block (&optional end)
473 "Selects a block and shows it. 641 "Selects a block and shows it.
474With prefix arg, reposition at end. Upon completion, point is 642With prefix arg, reposition at end. Upon completion, point is
475repositioned and the normal hook `hs-show-hook' is run. 643repositioned and the normal hook `hs-show-hook' is run.
476See documentation for `hs-hide-block' and `run-hooks'." 644See documentation for `hs-hide-block' and `run-hooks'."
477 (interactive "P") 645 (interactive "P")
478 (hs-life-goes-on 646 (hs-life-goes-on
479 (let ((c-reg (hs-inside-comment-p))) 647 (let ((c-reg (hs-inside-comment-p)))
480 (if c-reg 648 (if (or c-reg
481 (progn 649 (looking-at hs-block-start-regexp)
482 (hs-flag-region (car c-reg) (nth 1 c-reg) nil) 650 (hs-find-block-beginning))
483 (hs-safety-is-job-n)
484 (goto-char (if end (nth 1 c-reg) (car c-reg))))
485 (if (or (looking-at hs-block-start-regexp)
486 (hs-find-block-beginning))
487 (progn 651 (progn
488 (hs-show-block-at-point end) 652 (hs-show-block-at-point end c-reg)
489 (hs-safety-is-job-n) 653 (hs-safety-is-job-n)
490 (run-hooks 'hs-show-hook))))))) 654 (run-hooks 'hs-show-hook))))))
491 655
492(defun hs-show-region (beg end) 656(defun hs-show-region (beg end)
493 "Shows all lines from BEG to END, without doing any block analysis. 657 "Shows all lines from BEG to END, without doing any block analysis.
@@ -515,13 +679,21 @@ Should be bound to a mouse key."
515 "Toggle hideshow minor mode. 679 "Toggle hideshow minor mode.
516With ARG, turn hideshow minor mode on if ARG is positive, off otherwise. 680With ARG, turn hideshow minor mode on if ARG is positive, off otherwise.
517When hideshow minor mode is on, the menu bar is augmented with hideshow 681When hideshow minor mode is on, the menu bar is augmented with hideshow
518commands and the hideshow commands are enabled. The variables 682commands and the hideshow commands are enabled.
519`selective-display' and `selective-display-ellipses' are set to t. 683The value '(hs . t) is added to `buffer-invisibility-spec'.
520Last, the normal hook `hs-minor-mode-hook' is run; see the doc 684Last, the normal hook `hs-minor-mode-hook' is run; see the doc
521for `run-hooks'. 685for `run-hooks'.
522 686
687The main commands are: `hs-hide-all', `hs-show-all', `hs-hide-block'
688and `hs-show-block'.
689Also see the documentation for the variable `hs-show-hidden-short-form'.
690
523Turning hideshow minor mode off reverts the menu bar and the 691Turning hideshow minor mode off reverts the menu bar and the
524variables to default values and disables the hideshow commands." 692variables to default values and disables the hideshow commands.
693
694Key bindings:
695\\{hs-minor-mode-map}"
696
525 (interactive "P") 697 (interactive "P")
526 (setq hs-minor-mode 698 (setq hs-minor-mode
527 (if (null arg) 699 (if (null arg)
@@ -577,8 +749,7 @@ variables to default values and disables the hideshow commands."
577 (define-key hs-minor-mode-map [menu-bar Hide/Show hs-show-block] 749 (define-key hs-minor-mode-map [menu-bar Hide/Show hs-show-block]
578 '("Show Block" . hs-show-block)) 750 '("Show Block" . hs-show-block))
579 (define-key hs-minor-mode-map [menu-bar Hide/Show hs-hide-block] 751 (define-key hs-minor-mode-map [menu-bar Hide/Show hs-hide-block]
580 '("Hide Block" . hs-hide-block)) 752 '("Hide Block" . hs-hide-block)))
581 )
582 753
583;; some housekeeping 754;; some housekeeping
584(or (assq 'hs-minor-mode minor-mode-map-alist) 755(or (assq 'hs-minor-mode minor-mode-map-alist)
@@ -592,16 +763,16 @@ variables to default values and disables the hideshow commands."
592;; make some variables buffer-local 763;; make some variables buffer-local
593(make-variable-buffer-local 'hs-minor-mode) 764(make-variable-buffer-local 'hs-minor-mode)
594(make-variable-buffer-local 'hs-c-start-regexp) 765(make-variable-buffer-local 'hs-c-start-regexp)
595(make-variable-buffer-local 'hs-c-end-regexp)
596(make-variable-buffer-local 'hs-block-start-regexp) 766(make-variable-buffer-local 'hs-block-start-regexp)
597(make-variable-buffer-local 'hs-block-end-regexp) 767(make-variable-buffer-local 'hs-block-end-regexp)
598(make-variable-buffer-local 'hs-forward-sexp-func) 768(make-variable-buffer-local 'hs-forward-sexp-func)
769(make-variable-buffer-local 'hs-adjust-block-beginning)
599(put 'hs-minor-mode 'permanent-local t) 770(put 'hs-minor-mode 'permanent-local t)
600(put 'hs-c-start-regexp 'permanent-local t) 771(put 'hs-c-start-regexp 'permanent-local t)
601(put 'hs-c-end-regexp 'permanent-local t)
602(put 'hs-block-start-regexp 'permanent-local t) 772(put 'hs-block-start-regexp 'permanent-local t)
603(put 'hs-block-end-regexp 'permanent-local t) 773(put 'hs-block-end-regexp 'permanent-local t)
604(put 'hs-forward-sexp-func 'permanent-local t) 774(put 'hs-forward-sexp-func 'permanent-local t)
775(put 'hs-adjust-block-beginning 'permanent-local t)
605 776
606 777
607;;;---------------------------------------------------------------------------- 778;;;----------------------------------------------------------------------------