perlmyvars.el

(defun search-backward-for-my (point)
  (goto-char point)
  (save-match-data
    (catch 'found-my
      (while t
        (unless (re-search-backward "\\bmy\\b" 0 t)
          (throw 'found-my nil))
        (when (eq (get-text-property (point) 'face) 'font-lock-keyword-face)
          (throw 'found-my (point)))))))

(defun search-backward-for-bracket (point)
  (goto-char point)
  (save-match-data
    (catch 'found-bracket
      (while t
        (unless (re-search-backward "\\([{}]\\)" 0 t)
          (throw 'found-bracket nil))
        (unless (eq (get-text-property (point) 'face) 'font-lock-string-face)
          (throw 'found-bracket (cons (elt (match-string 1) 0) (point))))))))

(defun perl-extract-my-names ()
  "Extract the names (with sigil) of variables defined by the
given 'my' statement, which must start at the current buffer
position. Returns a list of names. Removes all text properties
from names."
  (when (looking-at
         (concat "\\=my\\s-+"
                 "\\(?:"
                 "\\([$@%]\\w+\\)"       ; matches a single my entry
                 "\\|"                   ; or
                 "(\\s-*\\([$@%]\\w+\\)" ; multiple entries in parens
                 "\\s-*"                 ; grok whitespace
                 "\\(?:,\\s-*\\([$@%]\\w+\\)\\)*"
                 ")"
                 "\\)"
                 "\\s-*[;=]" ; add these terminators so that we don't
                             ; match incomplete lines (ie the user is
                             ; still typing them)

                 ))

    (let (var-names)
      ;; We either have a match in string 1 or 2 and above...
      (if (match-string 1)
          (setq var-names (list (match-string 1)))
        (let ((i 2))
          (setq var-names '())
          (while (match-string i)
            (let ((name (match-string i)))
              (setq var-names (cons name var-names)))
            (setq i (1+ i)))))
      
      (mapc (lambda (name) (set-text-properties 0 (length name) nil name))
            var-names))))

(defun perl-lexicals-at-point (&optional point)
  "Parses any \"my\" statements defined previously in the current
buffer to generate a list of lexicals which are visible from
POINT. If POINT is not given, the position of the current buffer
is used."
  (unless point (setq point (point)))
  
  (let ((bracket-point      (save-excursion
                              (search-backward-for-bracket point)))
        (my-point           (save-excursion
                              (search-backward-for-my point)))
        (found-scope-count  0)
        (found-lexicals    '()))
    (while my-point
      (if (and bracket-point (> (cdr bracket-point) my-point))

          ;; Keep track of how many scopes are opening and closing...
          (progn
            (if (char-equal (car bracket-point) ?})
                (setq found-scope-count (- found-scope-count 1))
              (setq found-scope-count (1+ found-scope-count)))

            ;; Find the next bracket (earlier in the file)...
            (setq bracket-point
                  (save-excursion
                    (search-backward-for-bracket (cdr bracket-point)))))

        ;; No found brackets or they are before the 'my'...
        (when (>= found-scope-count 0)
          (save-excursion
            (goto-char my-point)
            (setq found-lexicals (append (perl-extract-my-names)
                                         found-lexicals))))

        ;; Find the next my (earlier in the file)...
        (setq my-point
              (save-excursion
                (search-backward-for-my my-point)))))
    (delete-dups found-lexicals)))