Perl6-Pugs
view release on metacpan or search on metacpan
util/cperl-mode.el view on Meta::CPAN
;;; Recognision of HERE-DOCS improved yet more.
;;; Autonewline works on `}' without warnings.
;;; Autohelp works again on $_[0].
;;;; After 1.31
;;; perl-descr.el found its author - hi, Johan!
;;; Some support for correct indent after here-docs and friends (may
;;; be superseeded by eminent change to Emacs internals).
;;; Should work with older Emaxen as well ( `-style stuff removed).
;;;; After 1.32
;;; Started to add support for `syntax-table' property (should work
;;; with patched Emaxen), controlled by
;;; `cperl-use-syntax-table-text-property'. Currently recognized:
;;; All quote-like operators: m, s, y, tr, qq, qw, qx, q,
;;; // in most frequent context:
;;; after block or
;;; ~ { ( = | & + - * ! , ;
;;; or
;;; while if unless until and or not xor split grep map
;;; Here-documents, formats, PODs,
;;; ${...}
;;; 'abc$'
;;; sub a ($); sub a ($) {}
;;; (provide 'cperl-mode) was missing!
;;; `cperl-after-expr-p' is now much smarter after `}'.
;;; `cperl-praise' added to mini-docs.
;;; Utilities try to support subs-with-prototypes.
;;;; After 1.32.1
;;; `cperl-after-expr-p' is now much smarter after "() {}" and "word {}":
;;; if word is "else, map, grep".
;;; Updated for new values of syntax-table constants.
;;; Uses `help-char' (at last!) (disabled, does not work?!)
;;; A couple of regexps where missing _ in character classes.
;;; -s could be considered as start of regexp, 1../blah/ was not,
;;; as was not /blah/ at start of file.
;;;; After 1.32.2
;;; "\C-hv" was wrongly "\C-hf"
;;; C-hv was not working on `[index()]' because of [] in skip-chars-*.
;;; `__PACKAGE__' supported.
;;; Thanks for Greg Badros: `cperl-lazy-unstall' is more complete,
;;; `cperl-get-help' is made compatible with `query-replace'.
;;;; As of Apr 15, development version of 19.34 supports
;;;; `syntax-table' text properties. Try setting
;;;; `cperl-use-syntax-table-text-property'.
;;;; After 1.32.3
;;; We scan for s{}[] as well (in simplest situations).
;;; We scan for $blah'foo as well.
;;; The default is to use `syntax-table' text property if Emacs is good enough.
;;; `cperl-lineup' is put on C-M-| (=C-M-S-\\).
;;; Start of `cperl-beautify-regexp'.
;;;; After 1.32.4
;;; `cperl-tags-hier-init' did not work in text-mode.
;;; `cperl-noscan-files-regexp' had a misprint.
;;; Generation of Class Hierarchy was broken due to a bug in `x-popup-menu'
;;; in 19.34.
;;;; After 1.33:
;;; my,local highlight vars after {} too.
;;; TAGS could not be created before imenu was loaded.
;;; `cperl-indent-left-aligned-comments' created.
;;; Logic of `cperl-indent-exp' changed a little bit, should be more
;;; robust w.r.t. multiline strings.
;;; Recognition of blah'foo takes into account strings.
;;; Added '.al' to the list of Perl extensions.
;;; Class hierarchy is "mostly" sorted (need to rethink algorthm
;;; of pruning one-root-branch subtrees to get yet better sorting.)
;;; Regeneration of TAGS was busted.
;;; Can use `syntax-table' property when generating TAGS
;;; (governed by `cperl-use-syntax-table-text-property-for-tags').
;;;; After 1.35:
;;; Can process several =pod/=cut sections one after another.
;;; Knows of `extproc' when under `emx', indents with `__END__' and `__DATA__'.
;;; `cperl-under-as-char' implemented (XEmacs people like broken behaviour).
;;; Beautifier for regexps fixed.
;;; `cperl-beautify-level', `cperl-contract-level' coded
;;;
;;;; Emacs's 20.2 problems:
;;; `imenu.el' has bugs, `imenu-add-to-menubar' does not work.
;;; Couple of others problems with 20.2 were reported, my ability to check/fix
;;; them is very reduced now.
;;;; After 1.36:
;;; 'C-M-|' in XEmacs fixed
;;;; After 1.37:
;;; &&s was not recognized as start of regular expression;
;;; Will "preprocess" the contents of //e part of s///e too;
;;; What to do with s# blah # foo #e ?
;;; Should handle s;blah;foo;; better.
;;; Now the only known problems with regular expression recognition:
;;;;;;; s<foo>/bar/ - different delimiters (end ignored)
;;;;;;; s/foo/\\bar/ - backslash at start of subst (made into one chunk)
;;;;;;; s/foo// - empty subst (made into one chunk + '/')
;;;;;;; s/foo/(bar)/ - start-group at start of subst (internal group will not match backwards)
;;;; After 1.38:
;;; We highlight closing / of s/blah/foo/e;
;;; This handles s# blah # foo #e too;
;;; s//blah/, s///, s/blah// works again, and s#blah## too, the algorithm
;;; is much simpler now;
;;; Next round of changes: s\\\ works, s<blah>/foo/,
;;; comments between the first and the second part allowed
;;; Another problem discovered:
;;;;;;; s[foo] <blah>e - e part delimited by different <> (will not match)
;;; `cperl-find-pods-heres' somehow maybe called when string-face is undefined
;;; - put a stupid workaround for 20.1
;;;; After 1.39:
;;; Could indent here-docs for comments;
;;; These problems fixed:
;;;;;;; s/foo/\\bar/ - backslash at start of subst (made into two chunk)
;;;;;;; s[foo] <blah>e - "e" part delimited by "different" <> (will match)
;;; Matching brackets honor prefices, may expand abbreviations;
util/cperl-mode.el view on Meta::CPAN
;;; (`cperl-indent-parens-as-block'): New configuration variable.
;;; (`cperl-calculate-indent'): Merge cases of indenting non-BLOCK groups.
;;; Use `cperl-indent-parens-as-block'.
;;; (`cperl-find-pods-heres'): Test for =cut without empty line instead of
;;; complaining about no =cut.
;;; (`cperl-electric-pod'): Change the REx for POD from "\n\n=" to "^\n=".
;;; (`cperl-find-pods-heres'): Likewise.
;;; (`cperl-electric-pod'): Change `forward-sexp' to `forward-word':
;;; POD could've been marked as comment already.
;;; (`cperl-unwind-to-safe'): Unwind before start of POD too.
;;;; After 4.28:
;;; (`cperl-forward-re'): Throw an error at proper moment REx unfinished.
;;;; After 4.29:
;;; (`x-color-defined-p'): Make an extra case to peacify the warning.
;;; Toplevel: `defvar' to peacify the warnings.
;;; (`cperl-find-pods-heres'): Could access `font-lock-comment-face' in -nw.
;;;; No -nw-compile time warnings now.
;;; (`cperl-find-tags'): TAGS file had too short substring-to-search.
;;; Be less verbose in non-interactive mode
;;; (`imenu-example--create-perl-index'): Set index-marker after name
;;; (`cperl-outline-regexp'): New variable.
;;; (`cperl-outline-level'): Made compatible with `cperl-outline-regexp'.
;;; (`cperl-mode'): Made use `cperl-outline-regexp'.
;;;; After 4.30:
;;; (`cperl-find-pods-heres'): =cut the last thing, no blank line, was error.
;;; (`cperl-outline-level'): Make start-of-file same level as `package'.
;;;; After 4.31:
;;; (`cperl-electric-pod'): `head1' and `over' electric only if empty.
;;; (`cperl-unreadable-ok'): New variable.
;;; (`cperl-find-tags'): Use `cperl-unreadable-ok', do not fail
;;; on an unreadable file
;;; (`cperl-write-tags'): Use `cperl-unreadable-ok', do not fail
;;; on an unreadable directory
;;;; After 4.32:
;;; Syncronized with v1.60 from Emacs 21.3.
;;; Mostly docstring and formatting changes, and:
;;; (`cperl-noscan-files-regexp'): Do not scan CVS subdirs
;;; (`cperl-problems'): Note that newer XEmacsen may syntaxify too
;;; (`imenu-example--create-perl-index'):
;;; Renamed to `cperl-imenu--create-perl-index'
;;; (`cperl-mode'): Replace `make-variable-buffer-local' by `make-local-variable'
;;; (`cperl-setup-tmp-buf'): Likewise
;;; (`cperl-fix-line-spacing'): Fix a misprint of "t" for "\t"
;;; (`cperl-next-bad-style'): Fix misprints in character literals
;;;; After 4.33:
;;; (`cperl-font-lock-keywords'): +etc: Aliased to perl-font-lock-keywords.
;;;; After 4.34:
;;; Further updates of whitespace and spelling w.r.t. RMS version.
;;; (`cperl-font-lock-keywords'): +etc: Avoid warnings when aliasing.
;;; (`cperl-mode'): Use `normal-auto-fill-function' if present.
;;; (`cperl-use-major-mode'): New variable
;;; (`cperl-can-font-lock'): New variable; replaces `window-system'
;;; (`cperl-tags-hier-init'): use `display-popup-menus-p' (if present)
;;; to choose `x-popup-menu' vs `tmm-prompt'
;;;; 4.35 has the following differences from version 1.40+ of RMS Emacs:
;;; New variables `cperl-use-major-mode', `cperl-can-font-lock';
;;; `cperl-use-major-mode' is (effectively) 'cperl-mode in RMS.
;;; `cperl-under-as-char' is nil in RMS.
;;; Minor differences in docstrings, and `cperl-non-problems'.
;;; Backward compatibility addressed: (`); (function (lambda ...)); font-lock;
;;; (:italic t bold t) vs (:slant italic :weight bold) in faces;
;;; `normal-auto-fill-function'.
;;; RMS version has wrong logic in `cperl-calculate-indent': $a = { } is
;;; wrongly indented if the closing brace is on a separate line.
;;; Different choice of ordering if's for is-x-REx and (eq (char-after b) ?\#)
;;; in `cperl-find-pods-heres'. [Cosmetic]
;;;; After 4.35:
;;; (`cperl-find-pods-heres'): If no end of HERE-doc found, mark to the end
;;; of buffer. This enables recognition of end
;;; of HERE-doc "as one types".
;;; Require "\n" after trailing tag of HERE-doc.
;;; \( made non-quoting outside of string/comment
;;; (gdj-contributed).
;;; Likewise for \$.
;;; Remove `here-doc-group' text property at start
;;; (makes this property reliable).
;;; Text property `first-format-line' ==> t.
;;; Do not recognize $opt_s and $opt::s as s///.
;;; (`cperl-perldoc'): Use case-sensitive search (contributed).
;;; (`cperl-fix-line-spacing'): Allow "_" in $vars of foreach etc. when
;;; underscore isn't a word char (gdj-contributed).
;;; (`defun-prompt-regexp'): Allow prototypes.
;;; (`cperl-vc-header-alist'): Extract numeric version from the Id.
;;; Toplevel: Put toggle-autohelp into the mode menu.
;;; Better docs for toggle/set/unset autohelp.
;;; (`cperl-electric-backspace-untabify'): New customization variable
;;; (`cperl-after-expr-p'): Works after here-docs, formats, and PODs too
;;; (affects many electric constructs).
;;; (`cperl-calculate-indent'): Takes into account `first-format-line' ==>
;;; works after format.
;;; (`cperl-short-docs'): Make it work with ... too.
;;; "array context" ==> "list context"
;;; (`cperl-electric-keyword'): make $if (etc: "$@%&*") non-electric
;;; '(' after keyword would insert a doubled paren
;;; (`cperl-electric-paren'): documented affected by `cperl-electric-parens'
;;; (`cperl-electric-rparen'): Likewise
;;; (`cperl-build-manpage'): New function by Nick Roberts
;;; (`cperl-perldoc'): Make it work in XEmacs too
;;;; After 4.36:
;;; (`cperl-find-pods-heres'): Recognize s => 1 and {s} (as a key or varname),
;;; { s:: } and { s::bar::baz } as varnames.
;;; (`cperl-after-expr-p'): Updates syntaxification before checks
;;; (`cperl-calculate-indent'): Likewise
;;; Fix wrong indent of blocks starting with POD
;;; (`cperl-after-block-p'): Optional argument for checking for a pre-block
;;; Recognize `continue' blocks too.
;;; (`cperl-electric-brace'): use `cperl-after-block-p' for detection;
;;; Now works for else/continue/sub blocks
;;; (`cperl-short-docs'): Minor edits; make messages fit 80-column screen
util/cperl-mode.el view on Meta::CPAN
"Return the word at point or at P."
(save-excursion
(if p (goto-char p))
(or (cperl-word-at-point-hard)
(progn
(require 'etags)
(funcall (or (and (boundp 'find-tag-default-function)
find-tag-default-function)
(get major-mode 'find-tag-default-function)
;; XEmacs 19.12 has `find-tag-default-hook'; it is
;; automatically used within `find-tag-default':
'find-tag-default))))))
(defun cperl-info-on-command (command)
"Show documentation for Perl command COMMAND in other window.
If perl-info buffer is shown in some frame, uses this frame.
Customized by setting variables `cperl-shrink-wrap-info-frame',
`cperl-max-help-size'."
(interactive
(let* ((default (cperl-word-at-point))
(read (read-string
(format "Find doc for Perl function (default %s): "
default))))
(list (if (equal read "")
default
read))))
(let ((buffer (current-buffer))
(cmd-desc (concat "^" (regexp-quote command) "[^a-zA-Z_0-9]")) ; "tr///"
pos isvar height iniheight frheight buf win fr1 fr2 iniwin not-loner
max-height char-height buf-list)
(if (string-match "^-[a-zA-Z]$" command)
(setq cmd-desc "^-X[ \t\n]"))
(setq isvar (string-match "^[$@%]" command)
buf (cperl-info-buffer isvar)
iniwin (selected-window)
fr1 (window-frame iniwin))
(set-buffer buf)
(goto-char (point-min))
(or isvar
(progn (re-search-forward "^-X[ \t\n]")
(forward-line -1)))
(if (re-search-forward cmd-desc nil t)
(progn
;; Go back to beginning of the group (ex, for qq)
(if (re-search-backward "^[ \t\n\f]")
(forward-line 1))
(beginning-of-line)
;; Get some of
(setq pos (point)
buf-list (list buf "*info-perl-var*" "*info-perl*"))
(while (and (not win) buf-list)
(setq win (get-buffer-window (car buf-list) t))
(setq buf-list (cdr buf-list)))
(or (not win)
(eq (window-buffer win) buf)
(set-window-buffer win buf))
(and win (setq fr2 (window-frame win)))
(if (or (not fr2) (eq fr1 fr2))
(pop-to-buffer buf)
(special-display-popup-frame buf) ; Make it visible
(select-window win))
(goto-char pos) ; Needed (?!).
;; Resize
(setq iniheight (window-height)
frheight (frame-height)
not-loner (< iniheight (1- frheight))) ; Are not alone
(cond ((if not-loner cperl-max-help-size
cperl-shrink-wrap-info-frame)
(setq height
(+ 2
(count-lines
pos
(save-excursion
(if (re-search-forward
"^[ \t][^\n]*\n+\\([^ \t\n\f]\\|\\'\\)" nil t)
(match-beginning 0) (point-max)))))
max-height
(if not-loner
(/ (* (- frheight 3) cperl-max-help-size) 100)
(setq char-height (frame-char-height))
;; Non-functioning under OS/2:
(if (eq char-height 1) (setq char-height 18))
;; Title, menubar, + 2 for slack
(- (/ (x-display-pixel-height) char-height) 4)))
(if (> height max-height) (setq height max-height))
;;(message "was %s doing %s" iniheight height)
(if not-loner
(enlarge-window (- height iniheight))
(set-frame-height (window-frame win) (1+ height)))))
(set-window-start (selected-window) pos))
(message "No entry for %s found." command))
;;(pop-to-buffer buffer)
(select-window iniwin)))
(defun cperl-info-on-current-command ()
"Show documentation for Perl command at point in other window."
(interactive)
(cperl-info-on-command (cperl-word-at-point)))
(defun cperl-imenu-info-imenu-search ()
(if (looking-at "^-X[ \t\n]") nil
(re-search-backward
"^\n\\([-a-zA-Z_]+\\)[ \t\n]")
(forward-line 1)))
(defun cperl-imenu-info-imenu-name ()
(buffer-substring
(match-beginning 1) (match-end 1)))
(defun cperl-imenu-on-info ()
"Shows imenu for Perl Info Buffer.
Opens Perl Info buffer if needed."
(interactive)
(let* ((buffer (current-buffer))
imenu-create-index-function
imenu-prev-index-position-function
imenu-extract-index-name-function
(index-item (save-restriction
(save-window-excursion
(set-buffer (cperl-info-buffer nil))
util/cperl-mode.el view on Meta::CPAN
;; Name known
(setcdr cons1 (cons (cons fileind (vector file info))
(cdr cons1)))
;; First occurrence of the name, start alist
(setq cons1 (cons name (list (cons fileind (vector file info)))))
(if pack
(setcar (cdr cperl-hierarchy)
(cons cons1 (nth 1 cperl-hierarchy)))
(setcar cperl-hierarchy
(cons cons1 (car cperl-hierarchy)))))))
(end-of-line))))
(defun cperl-tags-hier-init (&optional update)
"Show hierarchical menu of classes and methods.
Finds info about classes by a scan of loaded TAGS files.
Supposes that the TAGS files contain fully qualified function names.
One may build such TAGS files from CPerl mode menu."
(interactive)
(require 'etags)
(require 'imenu)
(if (or update (null (nth 2 cperl-hierarchy)))
(let ((remover (function (lambda (elt) ; (name (file1...) (file2..))
(or (nthcdr 2 elt)
;; Only in one file
(setcdr elt (cdr (nth 1 elt)))))))
pack name cons1 to l1 l2 l3 l4 b)
;; (setq cperl-hierarchy '(() () ())) ; Would write into '() later!
(setq cperl-hierarchy (list l1 l2 l3))
(if cperl-xemacs-p ; Not checked
(progn
(or tags-file-name
;; Does this work in XEmacs?
(call-interactively 'visit-tags-table))
(message "Updating list of classes...")
(set-buffer (get-file-buffer tags-file-name))
(cperl-tags-hier-fill))
(or tags-table-list
(call-interactively 'visit-tags-table))
(mapcar
(function
(lambda (tagsfile)
(message "Updating list of classes... %s" tagsfile)
(set-buffer (get-file-buffer tagsfile))
(cperl-tags-hier-fill)))
tags-table-list)
(message "Updating list of classes... postprocessing..."))
(mapcar remover (car cperl-hierarchy))
(mapcar remover (nth 1 cperl-hierarchy))
(setq to (list nil (cons "Packages: " (nth 1 cperl-hierarchy))
(cons "Methods: " (car cperl-hierarchy))))
(cperl-tags-treeify to 1)
(setcar (nthcdr 2 cperl-hierarchy)
(cperl-menu-to-keymap (cons '("+++UPDATE+++" . -999) (cdr to))))
(message "Updating list of classes: done, requesting display...")
;;(cperl-imenu-addback (nth 2 cperl-hierarchy))
))
(or (nth 2 cperl-hierarchy)
(error "No items found"))
(setq update
;;; (imenu-choose-buffer-index "Packages: " (nth 2 cperl-hierarchy))
(if (if (fboundp 'display-popup-menus-p)
(let ((f 'display-popup-menus-p))
(funcall f))
window-system)
(x-popup-menu t (nth 2 cperl-hierarchy))
(require 'tmm)
(tmm-prompt (nth 2 cperl-hierarchy))))
(if (and update (listp update))
(progn (while (cdr update) (setq update (cdr update)))
(setq update (car update)))) ; Get the last from the list
(if (vectorp update)
(progn
(find-file (elt update 0))
(cperl-etags-goto-tag-location (elt update 1))))
(if (eq update -999) (cperl-tags-hier-init t)))
(defun cperl-tags-treeify (to level)
;; cadr of `to' is read-write. On start it is a cons
(let* ((regexp (concat "^\\(" (mapconcat
'identity
(make-list level "[_a-zA-Z0-9]+")
"::")
"\\)\\(::\\)?"))
(packages (cdr (nth 1 to)))
(methods (cdr (nth 2 to)))
l1 head tail cons1 cons2 ord writeto packs recurse
root-packages root-functions ms many_ms same_name ps
(move-deeper
(function
(lambda (elt)
(cond ((and (string-match regexp (car elt))
(or (eq ord 1) (match-end 2)))
(setq head (substring (car elt) 0 (match-end 1))
tail (if (match-end 2) (substring (car elt)
(match-end 2)))
recurse t)
(if (setq cons1 (assoc head writeto)) nil
;; Need to init new head
(setcdr writeto (cons (list head (list "Packages: ")
(list "Methods: "))
(cdr writeto)))
(setq cons1 (nth 1 writeto)))
(setq cons2 (nth ord cons1)) ; Either packs or meths
(setcdr cons2 (cons elt (cdr cons2))))
((eq ord 2)
(setq root-functions (cons elt root-functions)))
(t
(setq root-packages (cons elt root-packages))))))))
(setcdr to l1) ; Init to dynamic space
(setq writeto to)
(setq ord 1)
(mapcar move-deeper packages)
(setq ord 2)
(mapcar move-deeper methods)
(if recurse
(mapcar (function (lambda (elt)
(cperl-tags-treeify elt (1+ level))))
(cdr to)))
;;Now clean up leaders with one child only
(mapcar (function (lambda (elt)
(if (not (and (listp (cdr elt))
(eq (length elt) 2))) nil
(setcar elt (car (nth 1 elt)))
(setcdr elt (cdr (nth 1 elt))))))
(cdr to))
;; Sort the roots of subtrees
(if (default-value 'imenu-sort-function)
(setcdr to
(sort (cdr to) (default-value 'imenu-sort-function))))
;; Now add back functions removed from display
(mapcar (function (lambda (elt)
(setcdr to (cons elt (cdr to)))))
(if (default-value 'imenu-sort-function)
(nreverse
(sort root-functions (default-value 'imenu-sort-function)))
root-functions))
;; Now add back packages removed from display
(mapcar (function (lambda (elt)
(setcdr to (cons (cons (concat "package " (car elt))
(cdr elt))
(cdr to)))))
(if (default-value 'imenu-sort-function)
(nreverse
(sort root-packages (default-value 'imenu-sort-function)))
root-packages))))
;;;(x-popup-menu t
;;; '(keymap "Name1"
;;; ("Ret1" "aa")
;;; ("Head1" "ab"
;;; keymap "Name2"
;;; ("Tail1" "x") ("Tail2" "y"))))
(defun cperl-list-fold (list name limit)
(let (list1 list2 elt1 (num 0))
(if (<= (length list) limit) list
(setq list1 nil list2 nil)
(while list
(setq num (1+ num)
elt1 (car list)
list (cdr list))
(if (<= num imenu-max-items)
(setq list2 (cons elt1 list2))
(setq list1 (cons (cons name
(nreverse list2))
list1)
list2 (list elt1)
num 1)))
(nreverse (cons (cons name
(nreverse list2))
list1)))))
(defun cperl-menu-to-keymap (menu &optional name)
(let (list)
(cons 'keymap
(mapcar
(function
(lambda (elt)
(cond ((listp (cdr elt))
(setq list (cperl-list-fold
(cdr elt) (car elt) imenu-max-items))
(cons nil
(cons (car elt)
(cperl-menu-to-keymap list))))
(t
(list (cdr elt) (car elt) t))))) ; t is needed in 19.34
(cperl-list-fold menu "Root" imenu-max-items)))))
(defvar cperl-bad-style-regexp
(mapconcat 'identity
'("[^-\n\t <>=+!.&|(*/'`\"#^][-=+<>!|&^]" ; char sign
"[-<>=+^&|]+[^- \t\n=+<>~]") ; sign+ char
"\\|")
"Finds places such that insertion of a whitespace may help a lot.")
(defvar cperl-not-bad-style-regexp
(mapconcat
'identity
'("[^-\t <>=+]\\(--\\|\\+\\+\\)" ; var-- var++
"[a-zA-Z0-9_][|&][a-zA-Z0-9_$]" ; abc|def abc&def are often used.
"&[(a-zA-Z0-9_$]" ; &subroutine &(var->field)
"<\\$?\\sw+\\(\\.\\(\\sw\\|_\\)+\\)?>" ; <IN> <stdin.h>
"-[a-zA-Z][ \t]+[_$\"'`a-zA-Z]" ; -f file, -t STDIN
"-[0-9]" ; -5
"\\+\\+" ; ++var
"--" ; --var
".->" ; a->b
"->" ; a SPACE ->b
"\\[-" ; a[-1]
"\\\\[&$@*\\\\]" ; \&func
"^=" ; =head
"\\$." ; $|
"<<[a-zA-Z_'\"`]" ; <<FOO, <<'FOO'
"||"
"&&"
"[CBIXSLFZ]<\\(\\sw\\|\\s \\|\\s_\\|[\n]\\)*>" ; C<code like text>
"-[a-zA-Z_0-9]+[ \t]*=>" ; -option => value
;; Unaddressed trouble spots: = -abc, f(56, -abc) --- specialcased below
;;"[*/+-|&<.]+="
)
"\\|")
"If matches at the start of match found by `my-bad-c-style-regexp',
insertion of a whitespace will not help.")
(defvar found-bad)
(defun cperl-find-bad-style ()
"Find places in the buffer where insertion of a whitespace may help.
Prompts user for insertion of spaces.
Currently it is tuned to C and Perl syntax."
(interactive)
(let (found-bad (p (point)))
(setq last-nonmenu-event 13) ; To disable popup
(goto-char (point-min))
(map-y-or-n-p "Insert space here? "
(lambda (arg) (insert " "))
'cperl-next-bad-style
'("location" "locations" "insert a space into")
'((?\C-r (lambda (arg)
(let ((buffer-quit-function
'exit-recursive-edit))
(message "Exit with Esc Esc")
(recursive-edit)
t)) ; Consider acted upon
"edit, exit with Esc Esc")
(?e (lambda (arg)
(let ((buffer-quit-function
'exit-recursive-edit))
(message "Exit with Esc Esc")
(recursive-edit)
t)) ; Consider acted upon
"edit, exit with Esc Esc"))
t)
(if found-bad (goto-char found-bad)
(goto-char p)
(message "No appropriate place found"))))
(defun cperl-next-bad-style ()
(let (p (not-found t) (point (point)) found)
(while (and not-found
(re-search-forward cperl-bad-style-regexp nil 'to-end))
(setq p (point))
(goto-char (match-beginning 0))
(if (or
(looking-at cperl-not-bad-style-regexp)
;; Check for a < -b and friends
(and (eq (following-char) ?\-)
(save-excursion
(skip-chars-backward " \t\n")
(memq (preceding-char) '(?\= ?\> ?\< ?\, ?\( ?\[ ?\{))))
;; Now check for syntax type
(save-match-data
(setq found (point))
(beginning-of-defun)
(let ((pps (parse-partial-sexp (point) found)))
(or (nth 3 pps) (nth 4 pps) (nth 5 pps)))))
(goto-char (match-end 0))
(goto-char (1- p))
(setq not-found nil
found-bad found)))
(not not-found)))
;;; Getting help
(defvar cperl-have-help-regexp
;;(concat "\\("
(mapconcat
'identity
'("[$@%*&][0-9a-zA-Z_:]+\\([ \t]*[[{]\\)?" ; Usual variable
"[$@]\\^[a-zA-Z]" ; Special variable
"[$@][^ \n\t]" ; Special variable
"-[a-zA-Z]" ; File test
"\\\\[a-zA-Z0]" ; Special chars
( run in 1.547 second using v1.01-cache-2.11-cpan-364913b4093 )