comparison lisp/progmodes/cperl-mode.el @ 80057:1db7c78912f4

*** empty log message ***

80056:20a6490b2f90

	  ["Contract a group" cperl-contract-level
	   cperl-use-syntax-table-text-property]
	  ["Contract groups" cperl-contract-levels
	   cperl-use-syntax-table-text-property]
	  "----"
	  ["Find next interpolated" cperl-next-interpolated-REx 
	   (next-single-property-change (point-min) 'REx-interpolated)]
	  ["Find next interpolated (no //o)"
	   cperl-next-interpolated-REx-0
	   (or (text-property-any (point-min) (point-max) 'REx-interpolated t)
	       (text-property-any (point-min) (point-max) 'REx-interpolated 1))]

				  (progn
				    (forward-sexp -1)
				    (skip-chars-backward " \t")
				    (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*[ \t]*:")))
			     (get-text-property (point) 'first-format-line)))
		   
		   ;; Look at previous line that's at column 0
		   ;; to determine whether we are in top-level decls
		   ;; or function's arg decls.  Set basic-indent accordingly.
		   ;; Now add a little if this is a continuation line.
		   (and state

	 ;; Indenter for stuff at toplevel
	 ;;
	 ((eq 'toplevel (elt i 0)) ;; [toplevel start char-after state immed-after-block]
	  (+ (save-excursion		; To beg-of-defun, or end of last sexp
	       (goto-char (elt i 1))	; start = Good place to start parsing
	       (- (current-indentation) ; 
		  (if (elt i 4) cperl-indent-level 0)))	; immed-after-block
	     (if (eq (elt i 2) ?{) cperl-continued-brace-offset 0) ; char-after
	     ;; Look at previous line that's at column 0
	     ;; to determine whether we are in top-level decls
	     ;; or function's arg decls.  Set basic-indent accordingly.

				     (progn
				       (goto-char tb)
	       ;;; XXX What to do: foo <<bar ???
	       ;;; XXX Need to support print {a} <<B ???
				       (forward-sexp -1)
				       (save-match-data	
					; $foo << b; $f .= <<B;
					; ($f+1) << b; a($f) . <<B;
					; foo 1, <<B; $x{a} <<b;
					 (cond
					  ((looking-at "[0-9$({]")

			  e1 (match-end 4))) ; 3 + 1
		  (setq tag (buffer-substring b1 e1)
			qtag (regexp-quote tag))
		  (cond (cperl-pod-here-fontify
			 ;; Highlight the starting delimiter
			 (cperl-postpone-fontification 
			  b1 e1 'face my-cperl-delimiters-face)
			 (cperl-put-do-not-fontify b1 e1 t)))
		  (forward-line)
		  (setq i (point))
		  (if end-of-here-doc

;;;m?(\?\?{b,a})? + m/(??{aa})(?(?=xx)aa|bb)(?#aac)/;
;;;m$(^ab[c]\$)$ + m+(^ab[c]\$\+)+ + m](^ab[c\]$|.+)] + m)(^ab[c]$|.+\));
;;;m^a[\^b]c^ + m.a[^b]\.c.;
			(save-excursion
			  (goto-char (1+ b))
			  ;; First 
			  (cperl-look-at-leading-count is-x-REx e)
			  (setq hairy-RE
				(concat
				 (if is-x-REx
				     (if (eq (char-after b) ?\#)

				;; Test for arguments:
				(cond
				 ;; This is not pretty: the 5.8.7 logic:
				 ;; \0numx  -> octal (up to total 3 dig)
				 ;; \DIGIT  -> backref unless \0
				 ;; \DIGITs -> backref if legal
				 ;;	     otherwise up to 3 -> octal
				 ;; Do not try to distinguish, we guess
				 ((or (and (memq qtag (append "01234567" nil))
					   (re-search-forward
					    "\\=[01234567]?[01234567]?"
					    (1- e) 'to-end))
				      (and (memq qtag (append "89" nil))
					   (re-search-forward 
					    "\\=[0123456789]*" (1- e) 'to-end))
				      (and (eq qtag ?x)
					   (re-search-forward
					    "\\=[0-9a-fA-F][0-9a-fA-F]?\\|\\={[0-9a-fA-F]+}"
					    (1- e) 'to-end))

				     (forward-char 1)))
			      ;; Apparently, I can't put \] into a charclass
			      ;; in m]]: m][\\\]\]] produces [\\]]
;;; POSIX?  [:word:] [:^word:] only inside []
;;;				       "\\=\\(\\\\.\\|[^][\\\\]\\|\\[:\\^?\sw+:]\\|\\[[^:]\\)*]")
			      (while 
				  (and argument
				       (re-search-forward
					(if (eq (char-after b) ?\] )
					    "\\=\\(\\\\[^]]\\|[^]\\\\]\\)*\\\\]"
					  "\\=\\(\\\\.\\|[^]\\\\]\\)*]")

		       (,(concat "\\="
				   cperl-maybe-white-and-comment-rex
				   ","
				   cperl-maybe-white-and-comment-rex
				   "\\([$@%*]\\([a-zA-Z0-9_:]+\\|[^a-zA-Z0-9_]\\)\\)")
			;; Bug in font-lock: limit is used not only to limit 
			;; searches, but to set the "extend window for
			;; facification" property.  Thus we need to minimize.
			,(if cperl-font-lock-multiline
			     '(if (match-beginning 3)
				  (save-excursion

for correct operation it should start and end outside any special syntactic
construct.  DONE-TO and STATEPOS indicate changes to internal caches maintained
by CPerl."
  (interactive "P")
  (or arg
      (setq arg (if (eq cperl-syntaxify-by-font-lock 
			(if backtrace 'backtrace 'message)) 0 1)))
  (setq arg (if (> arg 0) (if backtrace 'backtrace 'message) t))
  (setq cperl-syntaxify-by-font-lock arg)
  (message "Debugging messages of syntax unwind %sabled."
	   (if (eq arg t) "dis" "en")))

      (cperl-beautify-regexp-piece b e nil deep))))

(defun cperl-invert-if-unless-modifiers ()
  "Change `B if A;' into `if (A) {B}' etc if possible.
\(Unfinished.)"
  (interactive)				; 
  (let (A B pre-B post-B pre-if post-if pre-A post-A if-string
	  (w-rex "\\<\\(if\\|unless\\|while\\|until\\|for\\|foreach\\)\\>"))
    (and (= (char-syntax (preceding-char)) ?w)
	 (forward-sexp -1))
    (setq pre-if (point))

80057:1db7c78912f4

	  ["Contract a group" cperl-contract-level
	   cperl-use-syntax-table-text-property]
	  ["Contract groups" cperl-contract-levels
	   cperl-use-syntax-table-text-property]
	  "----"
	  ["Find next interpolated" cperl-next-interpolated-REx
	   (next-single-property-change (point-min) 'REx-interpolated)]
	  ["Find next interpolated (no //o)"
	   cperl-next-interpolated-REx-0
	   (or (text-property-any (point-min) (point-max) 'REx-interpolated t)
	       (text-property-any (point-min) (point-max) 'REx-interpolated 1))]

				  (progn
				    (forward-sexp -1)
				    (skip-chars-backward " \t")
				    (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*[ \t]*:")))
			     (get-text-property (point) 'first-format-line)))

		   ;; Look at previous line that's at column 0
		   ;; to determine whether we are in top-level decls
		   ;; or function's arg decls.  Set basic-indent accordingly.
		   ;; Now add a little if this is a continuation line.
		   (and state

	 ;; Indenter for stuff at toplevel
	 ;;
	 ((eq 'toplevel (elt i 0)) ;; [toplevel start char-after state immed-after-block]
	  (+ (save-excursion		; To beg-of-defun, or end of last sexp
	       (goto-char (elt i 1))	; start = Good place to start parsing
	       (- (current-indentation) ;
		  (if (elt i 4) cperl-indent-level 0)))	; immed-after-block
	     (if (eq (elt i 2) ?{) cperl-continued-brace-offset 0) ; char-after
	     ;; Look at previous line that's at column 0
	     ;; to determine whether we are in top-level decls
	     ;; or function's arg decls.  Set basic-indent accordingly.

				     (progn
				       (goto-char tb)
	       ;;; XXX What to do: foo <<bar ???
	       ;;; XXX Need to support print {a} <<B ???
				       (forward-sexp -1)
				       (save-match-data
					; $foo << b; $f .= <<B;
					; ($f+1) << b; a($f) . <<B;
					; foo 1, <<B; $x{a} <<b;
					 (cond
					  ((looking-at "[0-9$({]")

			  e1 (match-end 4))) ; 3 + 1
		  (setq tag (buffer-substring b1 e1)
			qtag (regexp-quote tag))
		  (cond (cperl-pod-here-fontify
			 ;; Highlight the starting delimiter
			 (cperl-postpone-fontification
			  b1 e1 'face my-cperl-delimiters-face)
			 (cperl-put-do-not-fontify b1 e1 t)))
		  (forward-line)
		  (setq i (point))
		  (if end-of-here-doc

;;;m?(\?\?{b,a})? + m/(??{aa})(?(?=xx)aa|bb)(?#aac)/;
;;;m$(^ab[c]\$)$ + m+(^ab[c]\$\+)+ + m](^ab[c\]$|.+)] + m)(^ab[c]$|.+\));
;;;m^a[\^b]c^ + m.a[^b]\.c.;
			(save-excursion
			  (goto-char (1+ b))
			  ;; First
			  (cperl-look-at-leading-count is-x-REx e)
			  (setq hairy-RE
				(concat
				 (if is-x-REx
				     (if (eq (char-after b) ?\#)

				;; Test for arguments:
				(cond
				 ;; This is not pretty: the 5.8.7 logic:
				 ;; \0numx  -> octal (up to total 3 dig)
				 ;; \DIGIT  -> backref unless \0
				 ;; \DIGITs -> backref if valid
				 ;;	     otherwise up to 3 -> octal
				 ;; Do not try to distinguish, we guess
				 ((or (and (memq qtag (append "01234567" nil))
					   (re-search-forward
					    "\\=[01234567]?[01234567]?"
					    (1- e) 'to-end))
				      (and (memq qtag (append "89" nil))
					   (re-search-forward
					    "\\=[0123456789]*" (1- e) 'to-end))
				      (and (eq qtag ?x)
					   (re-search-forward
					    "\\=[0-9a-fA-F][0-9a-fA-F]?\\|\\={[0-9a-fA-F]+}"
					    (1- e) 'to-end))

				     (forward-char 1)))
			      ;; Apparently, I can't put \] into a charclass
			      ;; in m]]: m][\\\]\]] produces [\\]]
;;; POSIX?  [:word:] [:^word:] only inside []
;;;				       "\\=\\(\\\\.\\|[^][\\\\]\\|\\[:\\^?\sw+:]\\|\\[[^:]\\)*]")
			      (while
				  (and argument
				       (re-search-forward
					(if (eq (char-after b) ?\] )
					    "\\=\\(\\\\[^]]\\|[^]\\\\]\\)*\\\\]"
					  "\\=\\(\\\\.\\|[^]\\\\]\\)*]")

		       (,(concat "\\="
				   cperl-maybe-white-and-comment-rex
				   ","
				   cperl-maybe-white-and-comment-rex
				   "\\([$@%*]\\([a-zA-Z0-9_:]+\\|[^a-zA-Z0-9_]\\)\\)")
			;; Bug in font-lock: limit is used not only to limit
			;; searches, but to set the "extend window for
			;; facification" property.  Thus we need to minimize.
			,(if cperl-font-lock-multiline
			     '(if (match-beginning 3)
				  (save-excursion

for correct operation it should start and end outside any special syntactic
construct.  DONE-TO and STATEPOS indicate changes to internal caches maintained
by CPerl."
  (interactive "P")
  (or arg
      (setq arg (if (eq cperl-syntaxify-by-font-lock
			(if backtrace 'backtrace 'message)) 0 1)))
  (setq arg (if (> arg 0) (if backtrace 'backtrace 'message) t))
  (setq cperl-syntaxify-by-font-lock arg)
  (message "Debugging messages of syntax unwind %sabled."
	   (if (eq arg t) "dis" "en")))

      (cperl-beautify-regexp-piece b e nil deep))))

(defun cperl-invert-if-unless-modifiers ()
  "Change `B if A;' into `if (A) {B}' etc if possible.
\(Unfinished.)"
  (interactive)				;
  (let (A B pre-B post-B pre-if post-if pre-A post-A if-string
	  (w-rex "\\<\\(if\\|unless\\|while\\|until\\|for\\|foreach\\)\\>"))
    (and (= (char-syntax (preceding-char)) ?w)
	 (forward-sexp -1))
    (setq pre-if (point))