diff options
| author | Richard M. Stallman | 1997-05-29 05:23:39 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1997-05-29 05:23:39 +0000 |
| commit | 88039caa2b0561b8bee4d0381604a9c78a1dffa5 (patch) | |
| tree | 41c7e5f88742471bcb70a437439d35e73ed80c3d | |
| parent | f188b3c4b8facf2ba99783381e3ebf3a58c2f28b (diff) | |
| download | emacs-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.el | 499 |
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. | ||
| 132 | It has the form | ||
| 133 | (MODE START-RE END-RE COMMENT-START-RE FORWARD-SEXP-FUNC ADJUST-BEG-FUNC). | ||
| 93 | If present, hideshow will use these values for the start and end regexps, | 134 | If present, hideshow will use these values for the start and end regexps, |
| 94 | respectively. Since Algol-ish languages do not have single-character | 135 | respectively. Since Algol-ish languages do not have single-character |
| 95 | block delimiters, the function `forward-sexp' which is used by hideshow | 136 | block delimiters, the function `forward-sexp' which is used by hideshow |
| @@ -102,9 +143,15 @@ more values, use | |||
| 102 | 143 | ||
| 103 | For example: | 144 | For 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 | ||
| 149 | See the documentation for `hs-adjust-block-beginning' to see what | ||
| 150 | is the use of ADJUST-BEG-FUNC. | ||
| 151 | |||
| 152 | If any of those is left nil, hideshow will try to guess some values, see | ||
| 153 | `hs-grok-mode-type' for this. | ||
| 154 | |||
| 108 | Note that the regexps should not contain leading or trailing whitespace.") | 155 | Note 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. | ||
| 179 | If t only the first line is visible when a block is in the hidden state, | ||
| 180 | else 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 | |||
| 183 | An example of how this works: (in c-mode) | ||
| 184 | original: | ||
| 185 | |||
| 186 | /* My function main | ||
| 187 | some more stuff about main | ||
| 188 | */ | ||
| 189 | int | ||
| 190 | main(void) | ||
| 191 | { | ||
| 192 | int x=0; | ||
| 193 | return 0; | ||
| 194 | } | ||
| 195 | |||
| 196 | |||
| 197 | hidden and hs-show-hidden-short-form is nil | ||
| 198 | /* My function main... | ||
| 199 | */ | ||
| 200 | int | ||
| 201 | main(void) | ||
| 202 | {... | ||
| 203 | } | ||
| 204 | |||
| 205 | hidden and hs-show-hidden-short-form is t | ||
| 206 | /* My function main... | ||
| 207 | int | ||
| 208 | main(void) | ||
| 209 | { ... | ||
| 210 | |||
| 211 | |||
| 212 | The latest has the disadvantage of not being symetrical, but it saves | ||
| 213 | screen 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. |
| 141 | Differs from mode-specific comment regexps in that | 231 | Differs from mode-specific comment regexps in that |
| 142 | surrounding whitespace is stripped.") | 232 | surrounding whitespace is stripped.") |
| 143 | 233 | ||
| 144 | (defvar hs-c-end-regexp nil | ||
| 145 | "Regexp for end of comments. | ||
| 146 | See `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'. | |||
| 159 | For other modes such as simula, a more specialized function | 245 | For other modes such as simula, a more specialized function |
| 160 | is necessary.") | 246 | is 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. |
| 250 | It has effect only if `hs-show-hidden-short-form' is t. The block it | ||
| 251 | is hidden from the point returned by this function, as opposed to | ||
| 252 | hiding it from the point returned when searching | ||
| 253 | `hs-block-start-regexp'. In c-like modes, if we wish to also hide the | ||
| 254 | curly braces (if you think they occupy too much space on the screen), | ||
| 255 | this function should return the starting point (at the end of line) of | ||
| 256 | the hidden region. | ||
| 257 | |||
| 258 | It is called with a single argument ARG which is the the position in | ||
| 259 | buffer after the block beginning. | ||
| 260 | |||
| 261 | It should return the position from where we should start hiding. | ||
| 262 | |||
| 263 | It should not move the point. | ||
| 264 | |||
| 265 | See `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. |
| 181 | If FLAG is nil then text is shown, while if FLAG is t the text is hidden." | 283 | If 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. |
| 215 | COMMENT true means that it should hide a comment block, C-REG is a list | 314 | COMMENT-REG is a list of the form (BEGIN . END) and specifies the limits |
| 216 | of the form (BEGIN . END) and specifies the limits of the comment." | 315 | of 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 | 343 | COMMENT-REG is a list of the forme (BEGIN . END) and specifies the limits |
| 239 | (progn | 344 | of 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. |
| 293 | Actually, returns a list containing the buffer position of the start | 403 | Actually, returns a list containing the buffer position of the start |
| 294 | and the end of the comment." | 404 | and the end of the comment. A comment block can be hided only if on its |
| 295 | (save-excursion | 405 | starting line there are only white spaces preceding the actual comment |
| 296 | (let ((p (point)) | 406 | beginning, if we are inside of a comment but this condition is not |
| 297 | q | 407 | we return a list having a nil as its car and the end of comment position |
| 298 | p-aux) | 408 | as 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. |
| 345 | Return point, or nil if top-level." | 470 | Return 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'. | ||
| 549 | Arg is a position in buffer just after {. This goes back to the end of | ||
| 550 | the function header. The purpose is to save some space on the screen | ||
| 551 | when 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. |
| 449 | With prefix arg, reposition at end. Block is defined as a sexp for | 622 | With prefix arg, reposition at end. Block is defined as a sexp for |
| 450 | lispish modes, mode-specific otherwise. Comments are blocks, too. | 623 | lispish modes, mode-specific otherwise. Comments are blocks, too. |
| 451 | Upon completion, point is at repositioned and the normal hook | 624 | Upon 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. |
| 474 | With prefix arg, reposition at end. Upon completion, point is | 642 | With prefix arg, reposition at end. Upon completion, point is |
| 475 | repositioned and the normal hook `hs-show-hook' is run. | 643 | repositioned and the normal hook `hs-show-hook' is run. |
| 476 | See documentation for `hs-hide-block' and `run-hooks'." | 644 | See 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. |
| 516 | With ARG, turn hideshow minor mode on if ARG is positive, off otherwise. | 680 | With ARG, turn hideshow minor mode on if ARG is positive, off otherwise. |
| 517 | When hideshow minor mode is on, the menu bar is augmented with hideshow | 681 | When hideshow minor mode is on, the menu bar is augmented with hideshow |
| 518 | commands and the hideshow commands are enabled. The variables | 682 | commands and the hideshow commands are enabled. |
| 519 | `selective-display' and `selective-display-ellipses' are set to t. | 683 | The value '(hs . t) is added to `buffer-invisibility-spec'. |
| 520 | Last, the normal hook `hs-minor-mode-hook' is run; see the doc | 684 | Last, the normal hook `hs-minor-mode-hook' is run; see the doc |
| 521 | for `run-hooks'. | 685 | for `run-hooks'. |
| 522 | 686 | ||
| 687 | The main commands are: `hs-hide-all', `hs-show-all', `hs-hide-block' | ||
| 688 | and `hs-show-block'. | ||
| 689 | Also see the documentation for the variable `hs-show-hidden-short-form'. | ||
| 690 | |||
| 523 | Turning hideshow minor mode off reverts the menu bar and the | 691 | Turning hideshow minor mode off reverts the menu bar and the |
| 524 | variables to default values and disables the hideshow commands." | 692 | variables to default values and disables the hideshow commands. |
| 693 | |||
| 694 | Key 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 | ;;;---------------------------------------------------------------------------- |