Mercurial > emacs
comparison lisp/progmodes/hideshow.el @ 52873:2f6d31064afd
Rewrite one-armed `if'
constructs using either `when' or `unless'.
(hs-grok-mode-type): Elide superfluous `progn'; nfc.
author | Thien-Thi Nguyen <ttn@gnuvola.org> |
---|---|
date | Sat, 18 Oct 2003 01:04:28 +0000 |
parents | 35f18ddf38e0 |
children | b449e405ed0d |
comparison
equal
deleted
inserted
replaced
52872:420e2bc2b809 | 52873:2f6d31064afd |
---|---|
393 ; (setq buffer-invisibility-spec (list arg))) | 393 ; (setq buffer-invisibility-spec (list arg))) |
394 ; (t | 394 ; (t |
395 ; (setq buffer-invisibility-spec | 395 ; (setq buffer-invisibility-spec |
396 ; (cons arg buffer-invisibility-spec))))) | 396 ; (cons arg buffer-invisibility-spec))))) |
397 ; (defun remove-from-invisibility-spec (arg) | 397 ; (defun remove-from-invisibility-spec (arg) |
398 ; (if buffer-invisibility-spec | 398 ; (when buffer-invisibility-spec |
399 ; (setq buffer-invisibility-spec | 399 ; (setq buffer-invisibility-spec |
400 ; (delete arg buffer-invisibility-spec))))) | 400 ; (delete arg buffer-invisibility-spec))))) |
401 | 401 |
402 ;; hs-match-data | 402 ;; hs-match-data |
403 (defalias 'hs-match-data 'match-data) | 403 (defalias 'hs-match-data 'match-data) |
404 | 404 |
405 ;;--------------------------------------------------------------------------- | 405 ;;--------------------------------------------------------------------------- |
495 | 495 |
496 The block beginning is adjusted by `hs-adjust-block-beginning' | 496 The block beginning is adjusted by `hs-adjust-block-beginning' |
497 and then further adjusted to be at the end of the line." | 497 and then further adjusted to be at the end of the line." |
498 (if comment-reg | 498 (if comment-reg |
499 (hs-hide-comment-region (car comment-reg) (cadr comment-reg) end) | 499 (hs-hide-comment-region (car comment-reg) (cadr comment-reg) end) |
500 (if (looking-at hs-block-start-regexp) | 500 (when (looking-at hs-block-start-regexp) |
501 (let* ((mdata (hs-match-data t)) | 501 (let* ((mdata (hs-match-data t)) |
502 (pure-p (match-end 0)) | 502 (pure-p (match-end 0)) |
503 (p | 503 (p |
504 ;; `p' is the point at the end of the block beginning, | 504 ;; `p' is the point at the end of the block beginning, |
505 ;; which may need to be adjusted | 505 ;; which may need to be adjusted |
506 (save-excursion | 506 (save-excursion |
507 (goto-char (funcall (or hs-adjust-block-beginning | 507 (goto-char (funcall (or hs-adjust-block-beginning |
508 'identity) | 508 'identity) |
509 pure-p)) | 509 pure-p)) |
510 ;; whatever the adjustment, we move to eol | 510 ;; whatever the adjustment, we move to eol |
511 (end-of-line) | 511 (end-of-line) |
512 (point))) | 512 (point))) |
513 (q | 513 (q |
514 ;; `q' is the point at the end of the block | 514 ;; `q' is the point at the end of the block |
515 (progn (hs-forward-sexp mdata 1) | 515 (progn (hs-forward-sexp mdata 1) |
516 (end-of-line) | 516 (end-of-line) |
517 (point)))) | 517 (point)))) |
518 (if (and (< p (point)) (> (count-lines p q) 1)) | 518 (when (and (< p (point)) (> (count-lines p q) 1)) |
519 (overlay-put (hs-flag-region p q 'code) | 519 (overlay-put (hs-flag-region p q 'code) |
520 'hs-ofs | 520 'hs-ofs |
521 (- pure-p p))) | 521 (- pure-p p))) |
522 (goto-char (if end q (min p pure-p))))))) | 522 (goto-char (if end q (min p pure-p))))))) |
523 | 523 |
524 (defun hs-safety-is-job-n () | 524 (defun hs-safety-is-job-n () |
525 "Warn if `buffer-invisibility-spec' does not contain symbol `hs'." | 525 "Warn if `buffer-invisibility-spec' does not contain symbol `hs'." |
526 (unless (and (listp buffer-invisibility-spec) | 526 (unless (and (listp buffer-invisibility-spec) |
527 (assq 'hs buffer-invisibility-spec)) | 527 (assq 'hs buffer-invisibility-spec)) |
566 (> (point) p) | 566 (> (point) p) |
567 (not (looking-at hs-c-start-regexp))) | 567 (not (looking-at hs-c-start-regexp))) |
568 (setq p (point));; use this to avoid an infinite cycle | 568 (setq p (point));; use this to avoid an infinite cycle |
569 (forward-comment 1) | 569 (forward-comment 1) |
570 (skip-chars-forward " \t\n\f")) | 570 (skip-chars-forward " \t\n\f")) |
571 (if (or (not (looking-at hs-c-start-regexp)) | 571 (when (or (not (looking-at hs-c-start-regexp)) |
572 (> (point) q)) | 572 (> (point) q)) |
573 ;; we cannot hide this comment block | 573 ;; we cannot hide this comment block |
574 (setq not-hidable t))) | 574 (setq not-hidable t))) |
575 ;; goto the end of the comment | 575 ;; goto the end of the comment |
576 (forward-comment (buffer-size)) | 576 (forward-comment (buffer-size)) |
577 (skip-chars-backward " \t\n\f") | 577 (skip-chars-backward " \t\n\f") |
578 (end-of-line) | 578 (end-of-line) |
579 (if (>= (point) q) | 579 (when (>= (point) q) |
580 (list (if not-hidable nil p) (point)))))))) | 580 (list (if not-hidable nil p) (point)))))))) |
581 | 581 |
582 (defun hs-grok-mode-type () | 582 (defun hs-grok-mode-type () |
583 "Set up hideshow variables for new buffers. | 583 "Set up hideshow variables for new buffers. |
584 If `hs-special-modes-alist' has information associated with the | 584 If `hs-special-modes-alist' has information associated with the |
585 current buffer's major mode, use that. | 585 current buffer's major mode, use that. |
605 (substring c-start-regexp | 605 (substring c-start-regexp |
606 0 (1- (match-end 0))) | 606 0 (1- (match-end 0))) |
607 c-start-regexp))) | 607 c-start-regexp))) |
608 hs-forward-sexp-func (or (nth 4 lookup) 'forward-sexp) | 608 hs-forward-sexp-func (or (nth 4 lookup) 'forward-sexp) |
609 hs-adjust-block-beginning (nth 5 lookup))) | 609 hs-adjust-block-beginning (nth 5 lookup))) |
610 (progn | 610 (setq hs-minor-mode nil) |
611 (setq hs-minor-mode nil) | 611 (error "%s Mode doesn't support Hideshow Minor Mode" mode-name))) |
612 (error "%s Mode doesn't support Hideshow Minor Mode" mode-name)))) | |
613 | 612 |
614 (defun hs-find-block-beginning () | 613 (defun hs-find-block-beginning () |
615 "Reposition point at block-start. | 614 "Reposition point at block-start. |
616 Return point, or nil if original point was not in a block." | 615 Return point, or nil if original point was not in a block." |
617 (let ((done nil) | 616 (let ((done nil) |
665 (save-excursion | 664 (save-excursion |
666 (let ((c-reg (hs-inside-comment-p))) | 665 (let ((c-reg (hs-inside-comment-p))) |
667 (if (and c-reg (nth 0 c-reg)) | 666 (if (and c-reg (nth 0 c-reg)) |
668 ;; point is inside a comment, and that comment is hidable | 667 ;; point is inside a comment, and that comment is hidable |
669 (goto-char (nth 0 c-reg)) | 668 (goto-char (nth 0 c-reg)) |
670 (if (and (not c-reg) | 669 (when (and (not c-reg) |
671 (hs-find-block-beginning) | 670 (hs-find-block-beginning) |
672 (looking-at hs-block-start-regexp)) | 671 (looking-at hs-block-start-regexp)) |
673 ;; point is inside a block | 672 ;; point is inside a block |
674 (goto-char (match-end 0))))) | 673 (goto-char (match-end 0))))) |
675 (end-of-line) | 674 (end-of-line) |
676 (let ((overlays (overlays-at (point))) | 675 (let ((overlays (overlays-at (point))) |
677 (found nil)) | 676 (found nil)) |
678 (while (and (not found) (overlayp (car overlays))) | 677 (while (and (not found) (overlayp (car overlays))) |
679 (setq found (overlay-get (car overlays) 'hs) | 678 (setq found (overlay-get (car overlays) 'hs) |
886 | 885 |
887 ;;--------------------------------------------------------------------------- | 886 ;;--------------------------------------------------------------------------- |
888 ;; load-time actions | 887 ;; load-time actions |
889 | 888 |
890 ;; keymaps and menus | 889 ;; keymaps and menus |
891 (if hs-minor-mode-map | 890 (unless hs-minor-mode-map |
892 nil | |
893 (setq hs-minor-mode-map (make-sparse-keymap)) | 891 (setq hs-minor-mode-map (make-sparse-keymap)) |
894 (easy-menu-define hs-minor-mode-menu | 892 (easy-menu-define hs-minor-mode-menu |
895 hs-minor-mode-map | 893 hs-minor-mode-map |
896 "Menu used when hideshow minor mode is active." | 894 "Menu used when hideshow minor mode is active." |
897 (cons "Hide/Show" | 895 (cons "Hide/Show" |