sepia.el

   1 ;;; Sepia -- Simple Emacs-Perl InterAction: ugly, yet effective.
   2 ;;  (a.k.a. Septik -- Sean's Emacs-Perl Total Integration Kludge.)
   3
   4 ;; Author: Sean O'Rourke <seano@cpan.org>
   5 ;; Keywords: Perl, languages
   6
   7 ;; Copyright (C) 2004-2009 Sean O'Rourke.  All rights reserved, some
   8 ;;   wrongs reversed.  This code is distributed under the same terms
   9 ;;   as Perl itself.
  10
  11 ;;; Commentary:
  12
  13 ;; Sepia is a set of tools for Perl development in Emacs.  Its goal is
  14 ;; to extend CPerl mode with two contributions: fast code navigation
  15 ;; and interactive development.  It is inspired by Emacs' current
  16 ;; support for a number of other languages, including Lisp, Python,
  17 ;; Ruby, and Emacs Lisp.
  18 ;;
  19 ;; See sepia.texi, which comes with the distribution.
  20
  21 ;;; Code:
  22
  23 (require 'cperl-mode)
  24 (require 'gud)
  25 (require 'cl)
  26 ;; try optional modules, but don't bitch if we fail:
  27 (ignore-errors (require 'sepia-w3m))
  28 (ignore-errors (require 'sepia-tree))
  29 (ignore-errors (require 'sepia-ido))
  30 (ignore-errors (require 'sepia-snippet))
  31 ;; extensions that should always load (autoload later?)
  32 (require 'sepia-cpan)
  33
  34 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  35 ;;; Comint communication
  36
  37 (defvar sepia-perl5lib nil
  38 "* List of extra PERL5LIB directories for `sepia-repl'.")
  39
  40 (defvar sepia-program-name "perl"
  41 "* Perl program name.")
  42
  43 (defvar sepia-view-pod-function
  44   (if (featurep 'w3m) 'sepia-w3m-view-pod 'sepia-perldoc-buffer)
  45 "* Function to view current buffer's documentation.
  46
  47 Useful values include `sepia-w3m-view-pod' and `sepia-perldoc-buffer'.")
  48
  49 (defvar sepia-module-list-function
  50   (if (featurep 'w3m) 'w3m-find-file 'browse-url-of-file)
  51 "* Function to view a list of installed modules.
  52
  53 Useful values include `w3m-find-file' and `browse-url-of-buffer'.")
  54
  55 (defvar sepia-complete-methods t
  56 "* Non-nil if Sepia should try to complete methods for \"$x->\".
  57
  58 NOTE: this feature can be problematic, since it evaluates the
  59 object in order to find its type.  Currently completion is only
  60 attempted for objects that are simple scalars.")
  61
  62 (defvar sepia-indent-expand-abbrev t
  63 "* If non-NIL, `sepia-indent-or-complete' tries `expand-abbrev'.")
  64
  65 (defvar sepia-use-completion t
  66   "* Use completion based on Xref database.
  67
  68 Turning this off may speed up some operations, if you don't mind
  69 losing completion.")
  70
  71 (defvar sepia-eval-defun-include-decls t
  72   "* Generate and use a declaration list for `sepia-eval-defun'.
  73 Without this, code often will not parse; with it, evaluation may
  74 be a bit less responsive.  Note that since this only includes
  75 subs from the evaluation package, it may not always work.")
  76
  77 (defvar sepia-prefix-key "\M-."
  78   "* Prefix for functions in `sepia-keymap'.")
  79
  80 ;;; User options end here.
  81
  82 (defvar sepia-process nil
  83 "The perl process with which we're interacting.")
  84 (defvar sepia-output nil
  85 "Current perl output for a response to `sepia-eval-raw', appended
  86 to by `perl-collect-output'.")
  87 (defvar sepia-passive-output ""
  88 "Current perl output for miscellaneous user interaction, used to
  89 look for \";;;###\" lisp evaluation markers.")
  90
  91 (defvar sepia-perl-builtins nil
  92 "List of Perl builtins for completion.")
  93
  94 (defun sepia-collect-output (string)
  95 "Collect perl output for `sepia-eval-raw' into sepia-output."
  96   (setq sepia-output (concat sepia-output string))
  97   "")
  98
  99 (defun sepia-eval-raw (str)
 100   "Evaluate perl code STR, returning a pair (RESULT-STRING . OUTPUT)."
 101   (sepia-ensure-process)
 102   (let (ocpof)
 103     (unwind-protect
 104          (let ((sepia-output "")
 105                (start 0))
 106            (with-current-buffer (process-buffer sepia-process)
 107              (setq ocpof comint-preoutput-filter-functions
 108                    comint-preoutput-filter-functions
 109                    '(sepia-collect-output)))
 110            (setq str (concat "local $Sepia::STOPDIE=0;"
 111                              "local $Sepia::STOPWARN=0;"
 112                              "{ package " (sepia-buffer-package) ";"
 113                              str " }\n"))
 114            (comint-send-string sepia-process
 115                                (concat (format "<<%d\n" (length str)) str))
 116            (while (not (and sepia-output
 117                             (string-match "> $" sepia-output)))
 118              (accept-process-output sepia-process))
 119            (if (string-match "^;;;[0-9]+\n" sepia-output)
 120                (cons
 121                 (let* ((x (read-from-string sepia-output
 122                                             (+ (match-beginning 0) 3)))
 123                        (len (car x))
 124                        (pos (cdr x)))
 125                   (prog1 (substring sepia-output (1+ pos) (+ len pos 1))
 126                     (setq start (+ pos len 1))))
 127                 (and (string-match ";;;[0-9]+\n" sepia-output start)
 128                      (let* ((x (read-from-string
 129                                 sepia-output
 130                                 (+ (match-beginning 0) 3)))
 131                             (len (car x))
 132                             (pos (cdr x)))
 133                        (substring sepia-output (1+ pos) (+ len pos 1)))))
 134                (cons sepia-output nil)))
 135       (with-current-buffer (process-buffer sepia-process)
 136         (setq comint-preoutput-filter-functions ocpof)))))
 137
 138 (defun sepia-eval (str &optional context detailed)
 139 "Evaluate STR in CONTEXT (void by default), and return its result
 140 as a Lisp object.  If DETAILED is specified, return a
 141 pair (RESULT . OUTPUT)."
 142   (let* ((tmp (sepia-eval-raw
 143                (case context
 144                  (list-context
 145                   (concat "Sepia::tolisp([" str "])"))
 146                  (scalar-context
 147                   (concat "Sepia::tolisp(scalar(" str "))"))
 148                  (t (concat str ";1")))))
 149          (res (car tmp))
 150          (errs (cdr tmp)))
 151     (setq res (if context
 152                   (if (string= res "") "" (car (read-from-string res)))
 153                   1))
 154     (if detailed
 155         (cons res errs)
 156         res)))
 157
 158 (defun sepia-call (fn context &rest args)
 159 "Call perl function FN in CONTEXT with arguments ARGS, returning
 160 its result as a Lisp value."
 161   (sepia-eval (concat fn "(" (mapconcat #'sepia-lisp-to-perl args ", ") ")")
 162               context))
 163
 164 (defun sepia-watch-for-eval (string)
 165 "Monitor inferior Perl output looking for Lisp evaluation
 166 requests.  The format for these requests is
 167 \"\\n;;;###LENGTH\\nDATA\".  Only one such request can come from
 168 each inferior Perl prompt."
 169   (setq sepia-passive-output (concat sepia-passive-output string))
 170   (cond
 171     ((string-match "^;;;###[0-9]+" sepia-passive-output)
 172      (if (string-match "^;;;###\\([0-9]+\\)\n\\(?:.\\|\n\\)*\n\\(.*> \\)"
 173                          sepia-passive-output)
 174        (let* ((len (car (read-from-string
 175                          (match-string 1 sepia-passive-output))))
 176               (pos (1+ (match-end 1)))
 177               (res (ignore-errors (eval (car (read-from-string
 178                                               sepia-passive-output pos
 179                                               (+ pos len)))))))
 180          (message "%s => %s"
 181                   (substring sepia-passive-output pos (+ pos len)) res)
 182          (goto-char (point-max))
 183          (insert (substring sepia-passive-output (+ 1 pos len)))
 184          (set-marker (process-mark (get-buffer-process (current-buffer)))
 185                      (point))
 186          (setq sepia-passive-output ""))
 187        ""))
 188     (t (setq sepia-passive-output "") string)))
 189
 190
 191 (defvar sepia-metapoint-map
 192   (let ((map (make-sparse-keymap)))
 193     (when (featurep 'ido)
 194       (define-key map "j" 'sepia-jump-to-symbol))
 195     (dolist (kv '(("c" . sepia-callers)
 196                   ("C" . sepia-callees)
 197                   ("a" . sepia-apropos)
 198                   ("A" . sepia-var-apropos)
 199                   ("v" . sepia-var-uses)
 200                   ("V" . sepia-var-defs)
 201                   ;;              ("V" . sepia-var-assigns)
 202                   ("\M-." . sepia-dwim)
 203                   ;; ("\M-." . sepia-location)
 204                   ("l" . sepia-location)
 205                   ("f" . sepia-defs)
 206                   ("r" . sepia-rebuild)
 207                   ("m" . sepia-module-find)
 208                   ("n" . sepia-next)
 209                   ("t" . find-tag)
 210                   ("d" . sepia-perldoc-this)
 211                   ("u" . sepia-describe-object)))
 212       (define-key map (car kv) (cdr kv)))
 213     map)
 214   "Keymap for Sepia functions.  This is just an example of how you
 215 might want to bind your keys, which works best when bound to
 216 `\\M-.'.")
 217
 218 (defvar sepia-shared-map
 219   (let ((map (make-sparse-keymap)))
 220     (define-key map sepia-prefix-key sepia-metapoint-map)
 221     (define-key map "\M-," 'sepia-next)
 222     (define-key map "\C-\M-x" 'sepia-eval-defun)
 223     (define-key map "\C-c\C-l" 'sepia-load-file)
 224     (define-key map "\C-c\C-p" 'sepia-view-pod) ;was cperl-pod-spell
 225     (define-key map "\C-c\C-d" 'cperl-perldoc)
 226     (define-key map "\C-c\C-r" 'sepia-repl)
 227     (define-key map "\C-c\C-s" 'sepia-scratch)
 228     (define-key map "\C-c\C-e" 'sepia-eval-expression)
 229     (define-key map "\C-c!" 'sepia-set-cwd)
 230     (define-key map (kbd "TAB") 'sepia-indent-or-complete)
 231     map)
 232   "Sepia bindings common to all modes.")
 233
 234 ;;;###autoload
 235 (defun sepia-perldoc-this (name)
 236   "View perldoc for module at point."
 237   (interactive (list (sepia-interactive-arg 'module)))
 238   (let ((wc (current-window-configuration))
 239         (old-pd (symbol-function 'w3m-about-perldoc))
 240         (old-pdb (symbol-function 'w3m-about-perldoc-buffer)))
 241     (condition-case stuff
 242         (flet ((w3m-about-perldoc (&rest args)
 243                  (let ((res (apply old-pd args)))
 244                    (or res (error "lose: %s" args))))
 245                (w3m-about-perldoc-buffer (&rest args)
 246                  (let ((res (apply old-pdb args)))
 247                    (or res (error "lose: %s" args)))))
 248           (funcall (if (featurep 'w3m) 'w3m-perldoc 'cperl-perldoc) name))
 249       (error (set-window-configuration wc)))))
 250
 251 (defun sepia-view-pod ()
 252   "View POD for the current buffer."
 253   (interactive)
 254   (funcall sepia-view-pod-function))
 255
 256 (defun sepia-module-list ()
 257   "List installed modules with links to their documentation.
 258
 259 This lists not just top-level packages appearing in packlist
 260 files, but all documented modules on the system, organized by
 261 package."
 262   (interactive)
 263   (let ((file "/tmp/modlist.html"))
 264     ;; (unless (file-exists-p file)
 265     (sepia-eval-raw (format "Sepia::html_module_list(\"%s\")" file))
 266     (funcall sepia-module-list-function file)))
 267
 268 (defun sepia-package-list ()
 269   "List installed packages with links to their documentation.
 270
 271 This lists only top-level packages appearing in packlist files.
 272 For modules within packages, see `sepia-module-list'."
 273   (interactive)
 274   (let ((file "/tmp/packlist.html"))
 275     ;; (unless (file-exists-p file)
 276     (sepia-eval-raw (format "Sepia::html_package_list(\"%s\")" file))
 277     (funcall sepia-module-list-function file)))
 278
 279 (defun sepia-perldoc-buffer ()
 280   "View current buffer's POD using pod2html and `browse-url'.
 281
 282 Interactive users should call `sepia-view-pod'."
 283   (let ((buffer (get-buffer-create "*sepia-pod*"))
 284         (errs (get-buffer-create "*sepia-pod-errors*"))
 285         (inhibit-read-only t))
 286     (with-current-buffer buffer (erase-buffer))
 287     (save-window-excursion
 288       (shell-command-on-region (point-min) (point-max) "pod2html"
 289                                buffer nil errs))
 290     (with-current-buffer buffer (browse-url-of-buffer))))
 291
 292 (defun sepia-perl-name (sym &optional mod)
 293 "Convert a Perl name to a Lisp name."
 294   (setq sym (substitute ?_ ?- (if (symbolp sym) (symbol-name sym) sym)))
 295   (if mod
 296       (concat mod "::" sym)
 297       sym))
 298
 299 (defun sepia-live-p ()
 300   (and (processp sepia-process)
 301        (eq (process-status sepia-process) 'run)))
 302
 303 (defun sepia-ensure-process (&optional remote-host)
 304   (unless (sepia-live-p)
 305     (with-current-buffer (get-buffer-create "*sepia-repl*")
 306       (sepia-repl-mode)
 307       (set (make-local-variable 'sepia-passive-output) ""))
 308     (if remote-host
 309         (comint-exec "*sepia-repl*" "attachtty" "attachtty" nil
 310                      (list remote-host))
 311         (let ((stuff (split-string sepia-program-name nil t)))
 312           (comint-exec (get-buffer-create "*sepia-repl*")
 313                        "perl" (car stuff) nil
 314                        (append
 315                         (cdr stuff)
 316                         (mapcar (lambda (x) (concat "-I" x)) sepia-perl5lib)
 317                         '("-MSepia" "-MSepia::Xref"
 318                           "-e" "Sepia::repl")))))
 319     (setq sepia-process (get-buffer-process "*sepia-repl*"))
 320     (accept-process-output sepia-process 1)
 321     ;; Steal a bit from gud-common-init:
 322     (setq gud-running t)
 323     (setq gud-last-last-frame nil)
 324     (set-process-filter sepia-process 'gud-filter)
 325     (set-process-sentinel sepia-process 'gud-sentinel)))
 326
 327 ;;;###autoload
 328 (defun sepia-repl (&optional remote-host)
 329   "Start the Sepia REPL."
 330   (interactive (list (and current-prefix-arg
 331                           (read-string "Host: "))))
 332   (sepia-init) ;; set up keymaps, etc.
 333   (sepia-ensure-process remote-host)
 334   (pop-to-buffer (get-buffer "*sepia-repl*")))
 335
 336 (defun sepia-cont-or-restart ()
 337   (interactive)
 338   (if (get-buffer-process (current-buffer))
 339       (gud-cont current-prefix-arg)
 340     (sepia-repl)))
 341
 342 (defvar sepia-repl-mode-map
 343   (let ((map (copy-keymap sepia-shared-map)))
 344     (set-keymap-parent map gud-mode-map)
 345     (define-key map (kbd "<tab>") 'comint-dynamic-complete)
 346     (define-key map "\C-a" 'comint-bol)
 347     (define-key map "\C-c\C-r" 'sepia-cont-or-restart)
 348     map)
 349
 350 "Keymap for Sepia interactive mode.")
 351
 352 (define-derived-mode sepia-repl-mode gud-mode "Sepia REPL"
 353   "Major mode for the Sepia REPL.
 354
 355 \\{sepia-repl-mode-map}"
 356     ;; (set (make-local-variable 'comint-use-prompt-regexp) t)
 357     (modify-syntax-entry ?: "_")
 358     (modify-syntax-entry ?> ".")
 359     (set (make-local-variable 'comint-prompt-regexp) "^[^>\n]*> *")
 360     (set (make-local-variable 'gud-target-name) "sepia")
 361     (set (make-local-variable 'gud-marker-filter) 'sepia-gud-marker-filter)
 362     (set (make-local-variable 'gud-minor-mode) 'sepia)
 363     (sepia-install-eldoc)
 364
 365     (setq gud-comint-buffer (current-buffer))
 366     (setq gud-last-last-frame nil)
 367     (setq gud-sepia-acc nil)
 368
 369     (gud-def gud-break ",break %f:%l" "\C-b" "Set breakpoint at current line.")
 370     (gud-def gud-step ",step %p" "\C-s" "Step one line.")
 371     (gud-def gud-next ",next %p" "\C-n" "Step one line, skipping calls.")
 372     (gud-def gud-cont ",continue" "\C-r" "Continue.")
 373     (gud-def gud-print "%e" "\C-p" "Evaluate something.")
 374     (gud-def gud-remove ",delete %l %f" "\C-d" "Delete current breakpoint.")
 375     ;; Sadly, this hoses our keybindings.
 376     (compilation-shell-minor-mode 1)
 377     (set (make-local-variable 'comint-dynamic-complete-functions)
 378          '(sepia-complete-symbol comint-dynamic-complete-filename))
 379     (set (make-local-variable 'comint-preoutput-filter-functions)
 380          '(sepia-watch-for-eval))
 381     (run-hooks 'sepia-repl-mode-hook)
 382     )
 383
 384 (defvar gud-sepia-acc nil
 385   "Accumulator for `sepia-gud-marker-filter'.")
 386
 387 (defun sepia-gud-marker-filter (str)
 388   (setq gud-sepia-acc
 389         (if gud-sepia-acc
 390             (concat gud-sepia-acc str)
 391             str))
 392   (while (string-match "_<\\([^:>]+\\):\\([0-9]+\\)>\\(.*\\)" gud-sepia-acc)
 393     (setq gud-last-last-frame gud-last-frame
 394           gud-last-frame (cons
 395                           (match-string 1 gud-sepia-acc)
 396                           (string-to-number (match-string 2 gud-sepia-acc)))
 397           gud-sepia-acc (match-string 3 gud-sepia-acc)))
 398   (setq gud-sepia-acc
 399         (if (string-match "\\(_<.*\\)" gud-sepia-acc)
 400             (match-string 1 gud-sepia-acc)
 401             nil))
 402   str)
 403
 404 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 405 ;;; Xref
 406
 407 (defun define-xref-function (package name doc)
 408   "Define a lisp mirror for a low-level Sepia function."
 409   (let ((lisp-name (intern (format "xref-%s" name)))
 410         (pl-name (sepia-perl-name name package)))
 411     (fmakunbound lisp-name)
 412     (eval `(defun ,lisp-name (&rest args)
 413              ,doc
 414              (apply #'sepia-call ,pl-name 'list-context args)))))
 415
 416 (defun define-modinfo-function (name &optional doc context)
 417 "Define a lisp mirror for a function from Module::Info."
 418   (let ((name (intern (format "sepia-module-%s" name)))
 419         (pl-func (sepia-perl-name name))
 420         (full-doc (concat (or doc "") "
 421
 422 This function uses Module::Info, so it does not require that the
 423 module in question be loaded.")))
 424     (when (fboundp name) (fmakunbound name))
 425     (eval `(defun ,name (mod)
 426              ,full-doc
 427              (interactive (list (sepia-interactive-arg 'module)))
 428              (sepia-maybe-echo
 429               (sepia-call "Sepia::module_info" ',(or context 'scalar-context)
 430                          mod ,pl-func)
 431               (interactive-p))))))
 432
 433 (defun sepia-thing-at-point (what)
 434   "Like `thing-at-point', but hacked to avoid REPL prompt."
 435   (let ((th (thing-at-point what)))
 436     (and th (not (string-match "[ >]$" th)) th)))
 437
 438 (defvar sepia-sub-re "^ *sub\\s +\\(.+\\_>\\)")
 439
 440 (defvar sepia-history nil)
 441
 442 (defun sepia-interactive-arg (&optional sepia-arg-type)
 443 "Default argument for most Sepia functions.  TYPE is a symbol --
 444 either 'file to look for a file, or anything else to use the
 445 symbol at point."
 446   (let* ((default (case sepia-arg-type
 447                     (file (or (thing-at-point 'file) (buffer-file-name)))
 448                     (t (sepia-thing-at-point 'symbol))))
 449          (text (capitalize (symbol-name sepia-arg-type)))
 450          (choices
 451           (lambda (str &rest blah)
 452             (let ((completions (xref-completions
 453                                 (case sepia-arg-type
 454                                   (module nil)
 455                                   (variable "VARIABLE")
 456                                   (function "CODE")
 457                                   (t nil))
 458                                 str)))
 459               (when (eq sepia-arg-type 'module)
 460                 (setq completions
 461                       (remove-if (lambda (x) (string-match "::$" x)) completions)))
 462               completions)))
 463          (prompt (if default
 464                      (format "%s [%s]: " text default)
 465                      (format "%s: " text)))
 466          (ret (if sepia-use-completion
 467                   (completing-read prompt 'blah-choices nil nil nil 'sepia-history
 468                                    default)
 469                   (read-string prompt nil 'sepia-history default))))
 470     (push ret sepia-history)
 471     ret))
 472
 473 (defun sepia-interactive-module ()
 474 "Guess which module we should look things up in.  Prompting for a
 475 module all the time is a PITA, but I don't think this (choosing
 476 the current file's module) is a good alternative, either.  Best
 477 would be to choose the module based on what we know about the
 478 symbol at point."
 479   (let ((xs (xref-file-modules (buffer-file-name))))
 480     (if (= (length xs) 1)
 481         (car xs)
 482         nil)))
 483
 484 (defun sepia-maybe-echo (result &optional print-message)
 485   (when print-message
 486     (message "%s" result))
 487   result)
 488
 489 (defun sepia-find-module-file (mod)
 490   (or (sepia-module-file mod)
 491       (car (xref-guess-module-file mod))))
 492
 493 (defun sepia-module-find (mod)
 494 "Find the file defining module MOD."
 495   (interactive (list (sepia-interactive-arg 'module)))
 496   (let ((fn (sepia-find-module-file mod)))
 497     (if fn
 498         (progn
 499           (message "Module %s in %s." mod fn)
 500           (pop-to-buffer (find-file-noselect (expand-file-name fn))))
 501         (message "Can't find module %s." mod))))
 502
 503 (defmacro ifa (test then &rest else)
 504   `(let ((it ,test))
 505      (if it ,then ,@else)))
 506
 507 (defvar sepia-found-refiner)
 508
 509 (defun sepia-show-locations (locs)
 510   (when locs
 511     (pop-to-buffer (get-buffer-create "*sepia-places*"))
 512     (let ((inhibit-read-only t))
 513       (erase-buffer)
 514       (dolist (loc (sort (remove nil locs) ; XXX where's nil from?
 515                          (lambda (a b)
 516                            (or (string< (car a) (car b))
 517                                (and (string= (car a) (car b))
 518                                     (< (second a) (second b)))))))
 519         (destructuring-bind (file line name &rest blah) loc
 520           (let ((str (ifa (find-buffer-visiting file)
 521                           (with-current-buffer it
 522                             (ifa sepia-found-refiner
 523                                  (funcall it line name)
 524                                  (goto-line line))
 525                             (message "line for %s was %d, now %d" name line
 526                                      (line-number-at-pos))
 527                             (setq line (line-number-at-pos))
 528                             (let ((tmpstr
 529                                    (buffer-substring (sepia-bol-from (point))
 530                                                      (sepia-eol-from (point)))))
 531                               (if (> (length tmpstr) 60)
 532                                   (concat "\n    " tmpstr)
 533                                   tmpstr)))
 534                           "...")))
 535             (insert (format "%s:%d:%s\n" (abbreviate-file-name file) line str)))))
 536       (grep-mode)
 537       (goto-char (point-min)))))
 538
 539 (defmacro define-sepia-query (name doc &optional gen test prompt)
 540   "Define a sepia querying function."
 541   `(defun ,name (ident &optional module file line display-p)
 542      ,(concat doc "
 543
 544 With prefix arg, list occurences in a `grep-mode' buffer.
 545 Without, place the occurrences on `sepia-found', so that
 546 calling `sepia-next' will cycle through them.
 547
 548 Depending on the query, MODULE, FILE, and LINE may be used to
 549 narrow the results, as long as doing so leaves some matches.
 550 When called interactively, they are taken from the current
 551 buffer.
 552 ")
 553      (interactive (list (sepia-interactive-arg ,(or prompt ''function))
 554                         (sepia-interactive-module)
 555                         (buffer-file-name)
 556                         (line-number-at-pos (point))
 557                         current-prefix-arg
 558                         ))
 559      (let ((ret
 560             ,(if test
 561                  `(let ((tmp (,gen ident module file line)))
 562                     (or (mapcan #',test tmp) tmp))
 563                  `(,gen ident module file line))))
 564        ;; Always clear out the last found ring, because it's confusing
 565        ;; otherwise.
 566        (sepia-set-found nil ,(or prompt ''function))
 567        (if display-p
 568            (sepia-show-locations ret)
 569            (sepia-set-found ret ,(or prompt ''function))
 570            (sepia-next)))))
 571
 572 (define-sepia-query sepia-defs
 573     "Find all definitions of sub."
 574   xref-apropos
 575   xref-location)
 576
 577 (define-sepia-query sepia-callers
 578     "Find callers of FUNC."
 579   xref-callers
 580   xref-location)
 581
 582 (define-sepia-query sepia-callees
 583     "Find a sub's callees."
 584   xref-callees
 585   xref-location)
 586
 587 (define-sepia-query sepia-var-defs
 588     "Find a var's definitions."
 589   xref-var-defs
 590   (lambda (x) (setf (third x) ident) (list x))
 591   'variable)
 592
 593 (define-sepia-query sepia-var-uses
 594     "Find a var's uses."
 595   xref-var-uses
 596   (lambda (x) (setf (third x) ident) (list x))
 597   'variable)
 598
 599 (define-sepia-query sepia-var-assigns
 600     "Find/list assignments to a variable."
 601   xref-var-assigns
 602   (lambda (x) (setf (third x) ident) (list x))
 603   'variable)
 604
 605 (defalias 'sepia-package-defs 'sepia-module-describe)
 606
 607 (define-sepia-query sepia-apropos
 608     "Find/list subroutines matching regexp."
 609   (lambda (name &rest blah) (xref-apropos name 1))
 610   xref-location
 611   'function)
 612
 613 (define-sepia-query sepia-var-apropos
 614     "Find/list variables matching regexp."
 615   xref-var-apropos
 616   xref-var-defs
 617   'variable)
 618
 619 (defun sepia-location (name &optional jump-to)
 620   "Find the definition of NAME.
 621
 622 When called interactively (or with JUMP-TO true), go directly
 623 to this location."
 624   (interactive (list (sepia-interactive-arg 'function) t))
 625   (let* ((fl (or (car (xref-location name))
 626                  (car (remove-if #'null
 627                                  (apply #'xref-location (xref-apropos name)))))))
 628     (when (and (car fl) (string-match "^(eval " (car fl)))
 629       (message "Can't find definition of %s in %s." name (car fl))
 630       (setq fl nil))
 631     (if jump-to
 632         (if fl (progn
 633                  (sepia-set-found (list fl) 'function)
 634                  (sepia-next))
 635             (message "No definition for %s." name))
 636         fl)))
 637
 638 ;;;###autoload
 639 (defun sepia-dwim (&optional display-p)
 640     "Try to do the right thing with identifier at point.
 641 * Find all definitions, if thing-at-point is a function
 642 * Find all uses, if thing-at-point is a variable
 643 * Find documentation, if thing-at-point is a module
 644 * Prompt otherwise
 645 "
 646     (interactive "P")
 647     (multiple-value-bind (type obj) (sepia-ident-at-point)
 648       (sepia-set-found nil type)
 649       (let* ((module-doc-p nil)
 650              (ret
 651               (cond
 652                 ((member type '(?% ?$ ?@)) (xref-var-defs obj))
 653                 ((or (equal type ?&)
 654                      (let (case-fold-search)
 655                        (string-match "^[^A-Z]" obj)))
 656                  (list (sepia-location obj)))
 657                 ((sepia-looks-like-module obj)
 658                  (setq module-doc-p t)
 659                  `((,(sepia-perldoc-this obj) 1 nil nil)))
 660                 (t (setq module-doc-p t)
 661                    (call-interactively 'sepia-defs)))))
 662         (unless module-doc-p
 663           (if display-p
 664               (sepia-show-locations ret)
 665               (sepia-set-found ret type)
 666               (sepia-next))))))
 667
 668 (defun sepia-rebuild ()
 669   "Rebuild the Xref database."
 670   (interactive)
 671   (xref-rebuild))
 672
 673 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 674 ;;; Perl motion commands.
 675
 676 ;;; XXX -- these are a hack to prevent infinite recursion calling
 677 ;;; e.g. beginning-of-defun from beginning-of-defun-function.
 678 ;;; `beginning-of-defun' should handle this.
 679 (defmacro sepia-safe-bodf (&optional n)
 680   `(let ((beginning-of-defun-function
 681           (if (and (boundp 'beginning-of-defun-function)
 682                    (eq beginning-of-defun-function 'sepia-beginning-of-defun))
 683               nil
 684               beginning-of-defun-function)))
 685      (beginning-of-defun ,n)))
 686
 687 (defmacro sepia-safe-eodf (&optional n)
 688   `(let ((end-of-defun-function
 689           (if (and (boundp 'end-of-defun-function)
 690                    (eq end-of-defun-function 'sepia-end-of-defun))
 691               nil
 692               end-of-defun-function)))
 693      (end-of-defun ,n)))
 694
 695 (defun sepia-beginning-of-defun (&optional n)
 696 "Move to beginning of current function.
 697
 698 The prefix argument is the same as for `beginning-of-defun'."
 699   (interactive "p")
 700   (setq n (or n 1))
 701   (ignore-errors
 702     (when (< n 0)
 703       (sepia-end-of-defun (- n))
 704       (setq n 1))
 705     (re-search-backward sepia-sub-re nil nil n)))
 706
 707 (defun sepia-inside-defun ()
 708   "True if point is inside a sub."
 709   (condition-case nil
 710       (save-excursion
 711         (let ((cur (point)))
 712           (re-search-backward sepia-sub-re)
 713           (when (< (point) cur)
 714             (search-forward "{")
 715             (backward-char 1)
 716             (forward-sexp)
 717             (> (point) cur))))
 718     (error nil)))
 719
 720 (defun sepia-end-of-defun (&optional n)
 721   "Move to end of current function.
 722
 723 The prefix argument is the same as for `end-of-defun'."
 724   (interactive "p")
 725   (setq n (or n 1))
 726   (when (< n 0)
 727     (sepia-beginning-of-defun (- n))
 728     (setq n 1))
 729   ;; If we're outside a defun, skip to the next
 730   (ignore-errors
 731     (unless (sepia-inside-defun)
 732       (re-search-forward sepia-sub-re)
 733       (forward-char 1))
 734     (dotimes (i n)
 735       (re-search-backward sepia-sub-re)
 736       (search-forward "{")
 737       (backward-char 1)
 738       (forward-sexp))
 739     (point)))
 740
 741 (defun sepia-rename-lexical (old new &optional prompt)
 742   "Replace lexical variable OLD with NEW in the current function.
 743
 744 With prefix argument, query for each replacement.  It is an error
 745 to call this outside a function."
 746   (interactive
 747    (let ((old (sepia-thing-at-point 'symbol)))
 748      (list (read-string "Old name: " old nil old)
 749            (read-string "New name: ")
 750            current-prefix-arg)))
 751    (message "(%s %s)" old new)
 752    (unless (sepia-inside-defun)
 753      (error "Can't rename %s outside a defun." old))
 754    (setq old (concat "\\([$%@]\\)\\_<" (regexp-quote old) "\\_>")
 755          new
 756         (concat "\\1" new))
 757    (let ((bod (sepia-beginning-of-defun))
 758          (eod (sepia-end-of-defun)))
 759      (if prompt
 760        (query-replace-regexp old new nil bod eod)
 761        (replace-regexp old new nil bod eod))))
 762
 763 (defun sepia-defun-around-point (&optional where)
 764   "Return the text of function around point."
 765   (unless where
 766     (setq where (point)))
 767   (save-excursion
 768     (goto-char where)
 769     (and (sepia-beginning-of-defun)
 770          (match-string-no-properties 1))))
 771
 772 (defun sepia-lexicals-at-point (&optional where)
 773   "Find lexicals in scope at point."
 774   (interactive "d")
 775   (unless where
 776     (setq where (point)))
 777   (let ((subname (sepia-defun-around-point where))
 778         (mod (sepia-buffer-package)))
 779     (xref-lexicals (sepia-perl-name subname mod))))
 780
 781 ;;;###autoload
 782 (defun sepia-load-file (file &optional rebuild-p collect-warnings)
 783   "Reload a file (interactively, the current buffer's file).
 784
 785 With REBUILD-P (or a prefix argument when called interactively),
 786 also rebuild the xref database."
 787   (interactive (list (expand-file-name (buffer-file-name))
 788                      prefix-arg
 789                      (format "*%s errors*" (buffer-file-name))))
 790   (save-buffer)
 791   (when collect-warnings
 792     (let (kill-buffer-query-functions)
 793       (ignore-errors
 794         (kill-buffer collect-warnings))))
 795   (let* ((tmp (sepia-eval (format "do '%s' || ($@ && do { local $Sepia::Debug::STOPDIE; die $@ })" file)
 796                           'scalar-context t))
 797          (res (car tmp))
 798          (errs (cdr tmp)))
 799     (message "sepia: %s returned %s" (abbreviate-file-name file)
 800              (if (equal res "") "undef" res))
 801     (when (and collect-warnings
 802                (> (length errs) 1))
 803       (with-current-buffer (get-buffer-create collect-warnings)
 804         (let ((inhibit-read-only t))
 805           (delete-region (point-min) (point-max))
 806           (insert errs)
 807           (sepia-display-errors (point-min) (point-max))
 808           (pop-to-buffer (current-buffer))))))
 809   (when rebuild-p
 810     (xref-rebuild)))
 811
 812 (defvar sepia-found)
 813
 814 (defun sepia-set-found (list &optional type)
 815   (setq list
 816         (remove-if (lambda (x)
 817                      (or (not x)
 818                          (and (not (car x)) (string= (fourth x) "main"))))
 819                    list))
 820   (setq sepia-found (cons -1 list))
 821   (setq sepia-found-refiner (sepia-refiner type)))
 822
 823 (defun sepia-refiner (type)
 824   (case type
 825     (function
 826      (lambda (line ident)
 827       (let ((sub-re (concat "^\\s *sub\\s +.*" ident "\\_>")))
 828         ;; Test this because sometimes we get lucky and get the line
 829         ;; just right, in which case beginning-of-defun goes to the
 830         ;; previous defun.
 831           (or (and line
 832                    (progn
 833                      (goto-line line)
 834                      (beginning-of-defun)
 835                      (looking-at sub-re)))
 836               (progn (goto-char (point-min))
 837                      (re-search-forward sub-re nil t)))
 838           (beginning-of-line))))
 839     ;; Old version -- this may actually work better if
 840     ;; beginning-of-defun goes flaky on us.
 841 ;;         (or (re-search-backward sub-re
 842 ;;                                 (sepia-bol-from (point) -20) t)
 843 ;;             (re-search-forward sub-re
 844 ;;                                (sepia-bol-from (point) 10) t))
 845 ;;         (beginning-of-line)
 846     (variable
 847      (lambda (line ident)
 848        (let ((var-re (concat "\\_<" ident "\\_>")))
 849          (cond
 850            (line (goto-line line)
 851                  (or (re-search-backward var-re (sepia-bol-from (point) -5) t)
 852                      (re-search-forward var-re (sepia-bol-from (point) 5) t)))
 853            (t (goto-char (point-min))
 854               (re-search-forward var-re nil t))))))
 855     (t (lambda (line ident) (and line (goto-line line))))))
 856
 857 (defun sepia-next (&optional arg)
 858   "Go to the next thing (e.g. def, use) found by sepia."
 859   (interactive "p")
 860   (or arg (setq arg 1))
 861   (if (cdr sepia-found)
 862       (let ((i (car sepia-found))
 863             (list (cdr sepia-found))
 864             (len (length (cdr sepia-found)))
 865             (next (+ (car sepia-found) arg))
 866             (prompt ""))
 867         (if (and (= len 1) (>= i 0))
 868             (message "No more definitions.")
 869           ;; if stepwise found next or previous item, it can cycle
 870           ;; around the `sepia-found'. When at first or last item, get
 871           ;; a warning
 872           (if (= (abs arg) 1)
 873               (progn
 874                 (setq i next)
 875                 (if (< i 0)
 876                     (setq i (1- len))
 877                   (if (>= i len)
 878                       (setq i 0)))
 879                 (if (= i (1- len))
 880                     (setq prompt "Last one! ")
 881                   (if (= i 0)
 882                       (setq prompt "First one! "))))
 883             ;; if we skip several item, when arrive the first or last
 884             ;; item, we will stop at the one. But if we already at last
 885             ;; item, then keep going
 886             (if (< next 0)
 887                 (if (= i 0)
 888                     (setq i (mod next len))
 889                   (setq i 0
 890                         prompt "First one!"))
 891               (if (> next len)
 892                   (if (= i (1- len))
 893                       (setq i (mod next len))
 894                     (setq i (1- len)
 895                           prompt "Last one!")))))
 896           (setcar sepia-found i)
 897           (setq next (nth i list))
 898           (let ((file (car next))
 899                 (line (cadr next))
 900                 (short (nth 2 next))
 901                 (mod (nth 3 next)))
 902         (unless file
 903           (setq file (and mod (sepia-find-module-file mod)))
 904           (if file
 905                   (setcar next file)
 906                 (error "No file for %s." (car next))))
 907             (message "%s at %s:%s. %s" short file line prompt)
 908         (when (file-exists-p file)
 909           (find-file (or file (sepia-find-module-file mod)))
 910           (when sepia-found-refiner
 911             (funcall sepia-found-refiner line short))
 912           (beginning-of-line)
 913               (recenter)))))
 914       (message "No more definitions.")))
 915
 916 (defun sepia-previous (&optional arg)
 917   (interactive "p")
 918   (or arg (setq arg 1))
 919   (sepia-next (- arg)))
 920
 921 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 922 ;; Completion
 923
 924 (defun sepia-ident-before-point ()
 925   "Find the Perl identifier at or preceding point."
 926   (save-excursion
 927     (skip-syntax-backward " ")
 928     (backward-char 1)
 929     (sepia-ident-at-point)))
 930
 931 (defun sepia-simple-method-before-point ()
 932   "Find the \"simple\" method call before point.
 933
 934 Looks for a simple method called on a variable before point and
 935 returns the list (OBJECT METHOD).  For example, \"$x->blah\"
 936 returns '(\"$x\" \"blah\").  Only simple methods are recognized,
 937 because completing anything evaluates it, so completing complex
 938 expressions would lead to disaster."
 939   (when sepia-complete-methods
 940     (let ((end (point))
 941           (bound (max (- (point) 100) (point-min)))
 942           arrow beg)
 943       (save-excursion
 944         ;; XXX - can't do this because COMINT's syntax table is weird.
 945         ;; (skip-syntax-backward "_w")
 946         (skip-chars-backward "a-zA-Z0-9_")
 947         (when (looking-back "->\\s *" bound)
 948           (setq arrow (search-backward "->" bound))
 949           (skip-chars-backward "a-zA-Z0-9_:")
 950           (cond
 951             ;; $x->method
 952             ((char-equal (char-before (point)) ?$)
 953              (setq beg (1- (point))))
 954             ;; X::Class->method
 955             ((multiple-value-bind (type obj) (sepia-ident-at-point)
 956                (and (not type)
 957                     (sepia-looks-like-module obj)))
 958              (setq beg (point))))
 959           (when beg
 960             (list (buffer-substring-no-properties beg arrow)
 961                   (buffer-substring-no-properties (+ 2 arrow) end)
 962                   (buffer-substring-no-properties beg end))))))))
 963
 964 (defun sepia-ident-at-point ()
 965   "Find the Perl identifier at point."
 966   (save-excursion
 967     (let ((orig (point)))
 968       (when (looking-at "[%$@*&]")
 969         (forward-char 1))
 970       (let* ((beg (progn
 971                     (when (re-search-backward "[^A-Za-z_0-9:]" nil 'mu)
 972                       (forward-char 1))
 973                     (point)))
 974              (sigil (if (= beg (point-min))
 975                         nil
 976                       (char-before (point))))
 977              (end (progn
 978                     (when (re-search-forward "[^A-Za-z_0-9:]" nil 'mu)
 979                       (forward-char -1))
 980                     (point))))
 981         (if (= beg end)
 982             ;; try special variables
 983             (if (and (member (char-before orig) '(?$ ?@ ?%))
 984                      (member (car (syntax-after orig)) '(1 4 5 7 9)))
 985                 (list (char-before orig)
 986                       (buffer-substring-no-properties orig (1+ orig)))
 987               '(nil ""))
 988           ;; actual thing
 989           (list (when (member sigil '(?$ ?@ ?% ?* ?&)) sigil)
 990                 (buffer-substring-no-properties beg end)))))))
 991
 992 (defun sepia-function-at-point ()
 993   "Find the Perl function called at point."
 994   (condition-case nil
 995       (save-excursion
 996         (let ((pt (point))
 997               bof)
 998           (sepia-beginning-of-defun)
 999           (setq bof (point))
1000           (goto-char pt)
1001           (sepia-end-of-defun)
1002           (when (and (>= pt bof) (< pt (point)))
1003             (sepia-beginning-of-defun)
1004             (when (and (= (point) bof) (looking-at "\\s *sub\\s +"))
1005               (forward-char (length (match-string 0)))
1006               (concat (or (sepia-buffer-package) "")
1007                       "::"
1008                       (cadr (sepia-ident-at-point)))))))
1009         (error nil)))
1010
1011 (defun sepia-repl-complete ()
1012   "Try to complete the word at point in the REPL.
1013 Just like `sepia-complete-symbol', except that it also completes
1014 REPL shortcuts."
1015   (interactive)
1016   (error "TODO"))
1017
1018 (defvar sepia-shortcuts
1019   '(
1020 "break"     "eval"      "lsbreak"   "quit"      "size"      "wantarray"
1021 "cd"        "format"    "methods"   "reload"    "strict"    "who"
1022 "debug"     "freload"   "package"   "restart"   "test"
1023 "define"    "help"      "pdl"       "save"      "time"
1024 "delete"    "load"      "pwd"       "shell"     "undef"
1025 )
1026   "List of currently-defined REPL shortcuts.
1027
1028 XXX: this needs to be updated whenever you add one on the Perl side.")
1029
1030 (defun sepia-complete-symbol ()
1031   "Try to complete the word at point.
1032 The word may be either a global or lexical variable if it has a
1033 sigil, a module, or a function.  The function currently ignores
1034 module qualifiers, which may be annoying in larger programs.
1035
1036 The function is intended to be bound to \\M-TAB, like
1037 `lisp-complete-symbol'."
1038   (interactive)
1039   (let ((win (get-buffer-window "*Completions*" 0))
1040         len
1041         completions
1042         type
1043         meth)
1044     (if (and (eq last-command this-command)
1045              win (window-live-p win) (window-buffer win)
1046              (buffer-name (window-buffer win)))
1047
1048         ;; If this command was repeated, and
1049         ;; there's a fresh completion window with a live buffer,
1050         ;; and this command is repeated, scroll that window.
1051         (with-current-buffer (window-buffer win)
1052           (if (pos-visible-in-window-p (point-max) win)
1053               (set-window-start win (point-min))
1054             (save-selected-window
1055               (select-window win)
1056               (scroll-up))))
1057
1058       ;; Otherwise actually do completion:
1059       ;; 0 - try a shortcut
1060       (when (eq major-mode 'sepia-repl-mode)
1061         (save-excursion
1062           (comint-bol)
1063           (when (looking-at ",\\([a-z]+\\)$")
1064             (let ((str (match-string 1)))
1065               (setq len (length str)
1066                     completions (all-completions str sepia-shortcuts))))))
1067       ;; 1 - Look for a method call:
1068       (unless completions
1069         (setq meth (sepia-simple-method-before-point))
1070         (when meth
1071           (setq len (length (caddr meth))
1072                 completions (xref-method-completions
1073                              (cons 'expr (format "'%s'" (car meth)))
1074                              (cadr meth)
1075                              "Sepia::repl_eval")
1076                 type (format "%s->" (car meth)))))
1077       ;; 1.x - look for a module
1078       (unless completions
1079         (setq completions
1080               (and (looking-back " *\\(?:use\\|require\\|package\\|no\\)\\s +[^ ]*" (sepia-bol-from (point)))
1081                    (xref-apropos-module
1082                     (multiple-value-bind (typ name)
1083                         (sepia-ident-before-point)
1084                       (setq len (length name))
1085                       name))
1086               )))
1087
1088       (multiple-value-bind (typ name) (sepia-ident-before-point)
1089         (unless completions
1090           ;; 2 - look for a regular function/variable/whatever
1091           (setq type typ
1092                 len (+ (if type 1 0) (length name))
1093                 completions (xref-completions
1094                              (case type
1095                                (?$ "VARIABLE")
1096                                (?@ "ARRAY")
1097                                (?% "HASH")
1098                                (?& "CODE")
1099                                (?* "IO")
1100                                (t ""))
1101                              name
1102                              (and (eq major-mode 'sepia-mode)
1103                                   (sepia-function-at-point)))))
1104         ;; 3 - try a Perl built-in
1105         (when (and (not completions)
1106                    (or (not type) (eq type ?&)))
1107           (when (string-match ".*::([^:]+)$" name)
1108             (setq name (match-string 1 name)))
1109           (setq completions (all-completions name sepia-perl-builtins)))
1110         (case (length completions)
1111           (0 (message "No completions.") nil)
1112           (1 ;; XXX - skip sigil to match s-i-before-point
1113            (delete-region (- (point) len) (point))
1114            (insert (car completions))
1115            ;; Hide stale completions buffer (stolen from lisp.el).
1116            (if win (with-selected-window win (bury-buffer))) t)
1117           (t (let ((old name)
1118                    (new (try-completion "" completions)))
1119                (if (<= (length new) (+ (length old) (if type 1 0)))
1120                    (with-output-to-temp-buffer "*Completions*"
1121                      (display-completion-list completions))
1122                  (let ((win (get-buffer-window "*Completions*" 0)))
1123                    (if win (with-selected-window win (bury-buffer))))
1124                  (delete-region (- (point) len) (point))
1125                  (insert new))))))
1126       t)))
1127
1128 (defun sepia-indent-or-complete ()
1129 "Indent the current line or complete the symbol around point.
1130
1131 Specifically, try completion when indentation doesn't move point.
1132 This function is intended to be bound to TAB."
1133   (interactive)
1134   (let ((pos (point)))
1135     (let (beginning-of-defun-function
1136           end-of-defun-function)
1137       (cperl-indent-command))
1138     (when (and (= pos (point))
1139                (not (bolp))
1140                (or (eq last-command 'sepia-indent-or-complete)
1141                    (looking-at "\\_>")))
1142       (when (or (not sepia-indent-expand-abbrev)
1143                 (and (not (expand-abbrev))
1144                      ;; XXX this shouldn't be necessary, but
1145                      ;; expand-abbrev returns NIL for e.g. the "else"
1146                      ;; snippet.
1147                      (= pos (point))))
1148         (sepia-complete-symbol)))))
1149
1150 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1151 ;;; scratchpad code
1152
1153 (defvar sepia-mode-map
1154   (let ((map (copy-keymap sepia-shared-map)))
1155     (set-keymap-parent map cperl-mode-map)
1156     (define-key map "\C-c\C-h" nil)
1157     map)
1158  "Keymap for Sepia mode.")
1159
1160 ;;;###autoload
1161 (define-derived-mode sepia-mode cperl-mode "Sepia"
1162   "Major mode for Perl editing, derived from cperl mode.
1163 \\{sepia-mode-map}"
1164   (sepia-init)
1165   (sepia-install-eldoc)
1166   (sepia-doc-update)
1167   (set (make-local-variable 'beginning-of-defun-function)
1168        'sepia-beginning-of-defun)
1169   (set (make-local-variable 'end-of-defun-function)
1170        'sepia-end-of-defun)
1171   (setq indent-line-function 'sepia-indent-line))
1172
1173 (defun sepia-init ()
1174   "Perform the initialization necessary to start Sepia."
1175     ;; Load perl defs:
1176   ;; Create glue wrappers for Module::Info funcs.
1177   (unless (fboundp 'xref-completions)
1178     (dolist (x '((name "Find module name.\n\nDoes not require loading.")
1179                  (version "Find module version.\n\nDoes not require loading.")
1180                  (inc-dir "Find directory in which this module was found.\n\nDoes not require loading.")
1181                  (file "Absolute path of file defining this module.\n\nDoes not require loading.")
1182                  (is-core "Guess whether or not a module is part of the core distribution.
1183 Does not require loading.")
1184                  (modules-used "List modules used by this module.\n\nRequires loading." list-context)
1185                  (packages-inside "List sub-packages in this module.\n\nRequires loading." list-context)
1186                  (superclasses "List module's superclasses.\n\nRequires loading." list-context)))
1187       (apply #'define-modinfo-function x))
1188     ;; Create low-level wrappers for Sepia
1189     (dolist (x '((completions "Find completions in the symbol table.")
1190                  (method-completions "Complete on an object's methods.")
1191                  (location "Find an identifier's location.")
1192                  (mod-subs "Find all subs defined in a package.")
1193                  (mod-decls "Generate declarations for subs in a package.")
1194                  (mod-file "Find the file defining a package.")
1195                  (apropos "Find subnames matching RE.")
1196                  (lexicals "Find lexicals for a sub.")
1197                  (apropos-module "Find installed modules matching RE.")
1198                  ))
1199       (apply #'define-xref-function "Sepia" x))
1200
1201     (dolist (x '((rebuild "Build Xref database for current Perl process.")
1202                  (redefined "Rebuild Xref information for a given sub.")
1203
1204                  (callers "Find all callers of a function.")
1205                  (callees "Find all functions called by a function.")
1206
1207                  (var-apropos "Find varnames matching RE.")
1208                  (mod-apropos "Find modules matching RE.")
1209                  (file-apropos "Find files matching RE.")
1210
1211                  (var-defs "Find all definitions of a variable.")
1212                  (var-assigns "Find all assignments to a variable.")
1213                  (var-uses "Find all uses of a variable.")
1214
1215                  (mod-redefined "Rebuild Xref information for a given package.")
1216                  (guess-module-file "Guess file corresponding to module.")
1217                  (file-modules "List the modules defined in a file.")))
1218       (apply #'define-xref-function "Sepia::Xref" x))
1219     ;; Initialize built hash
1220     (sepia-init-perl-builtins)))
1221
1222 (defvar sepia-scratchpad-mode-map
1223   (let ((map (make-sparse-keymap)))
1224     (set-keymap-parent map sepia-mode-map)
1225     (define-key map "\C-j" 'sepia-scratch-send-line)
1226     map))
1227
1228 ;;;###autoload
1229 (define-derived-mode sepia-scratchpad-mode sepia-mode "Sepia-Scratch"
1230   "Major mode for the Perl scratchpad, derived from Sepia mode."
1231   (sepia-init))
1232
1233 ;;;###autoload
1234 (defun sepia-scratch ()
1235   "Switch to the sepia scratchpad."
1236   (interactive)
1237   (pop-to-buffer
1238    (or (get-buffer "*sepia-scratch*")
1239        (with-current-buffer (get-buffer-create "*sepia-scratch*")
1240          (sepia-scratchpad-mode)
1241          (current-buffer)))))
1242
1243 (defun sepia-scratch-send-line (&optional scalarp)
1244   "Send the current line to perl, and display the result."
1245   (interactive "P")
1246   (insert
1247    (format "\n%s\n"
1248            (car
1249             (sepia-eval-raw
1250              (concat "$Sepia::REPL{eval}->(q#"
1251                      (buffer-substring (sepia-bol-from (point))
1252                                        (sepia-eol-from (point))) "#)"))))))
1253
1254 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1255 ;; Miscellany
1256
1257 (defun sepia-indent-line (&rest args)
1258   "Unbind `beginning-of-defun-function' to not confuse `cperl-indent-line'."
1259   (let (beginning-of-defun-function)
1260     (apply #'cperl-indent-line args)))
1261
1262 (defun sepia-string-count-matches (reg str)
1263   (let ((n 0)
1264         (pos -1))
1265     (while (setq pos (string-match reg str (1+ pos)))
1266       (incf n))
1267     n))
1268
1269 (defun sepia-perlize-region-internal (pre post beg end replace-p)
1270   "Pass buffer text from BEG to END through a Perl command."
1271   (let* ((exp (concat pre "<<'SEPIA_END_REGION';\n"
1272                       (buffer-substring-no-properties beg end)
1273                       (if (= (char-before end) ?\n) "" "\n")
1274                       "SEPIA_END_REGION\n" post))
1275          (new-str (car (sepia-eval-raw exp))))
1276     (if replace-p
1277         (progn (delete-region beg end)
1278                (goto-char beg)
1279                (insert new-str))
1280         (if (> (sepia-string-count-matches "\n" new-str) 2)
1281             (with-current-buffer (get-buffer-create "*sepia-filter*")
1282               (let ((inhibit-read-only t))
1283                 (erase-buffer)
1284                 (insert new-str)
1285                 (goto-char (point-min))
1286                 (pop-to-buffer (current-buffer))))
1287             (message "%s" new-str)))))
1288
1289 (defun sepia-eol-from (pt &optional n)
1290   (save-excursion
1291     (goto-char pt)
1292     (end-of-line n)
1293     (point)))
1294
1295 (defun sepia-bol-from (pt &optional n)
1296   (save-excursion
1297     (goto-char pt)
1298     (beginning-of-line n)
1299     (point)))
1300
1301 (defun sepia-perl-pe-region (expr beg end &optional replace-p)
1302   "Do the equivalent of perl -pe on region
1303
1304 \(i.e. evaluate an expression on each line of region).  With
1305 prefix arg, replace the region with the result."
1306   (interactive "MExpression: \nr\nP")
1307   (sepia-perlize-region-internal
1308    "do { my $ret=''; local $_; local $/ = \"\\n\"; my $region = "
1309    (concat "; for (split /(?<=\\n)/, $region, -1) { " expr
1310            "} continue { $ret.=$_}; $ret}")
1311    (sepia-bol-from beg) (sepia-eol-from end) replace-p))
1312
1313 (defun sepia-perl-ne-region (expr beg end &optional replace-p)
1314   "Do the moral equivalent of perl -ne on region
1315
1316 \(i.e. evaluate an expression on each line of region).  With
1317 prefix arg, replace the region with the result."
1318   (interactive "MExpression: \nr\nP")
1319   (sepia-perlize-region-internal
1320    "do { my $ret='';my $region = "
1321    (concat "; for (split /(?<=\\n)/, $region, -1) { $ret .= do { " expr
1322            ";} }; ''.$ret}")
1323    (sepia-bol-from beg) (sepia-eol-from end) replace-p))
1324
1325 (defun sepia-perlize-region (expr beg end &optional replace-p)
1326   "Evaluate a Perl expression on the region as a whole.
1327
1328 With prefix arg, replace the region with the result."
1329   (interactive "MExpression: \nr\nP")
1330   (sepia-perlize-region-internal
1331    "do { local $_ = " (concat "; do { " expr ";}; $_ }") beg end replace-p))
1332
1333 (defun sepia-core-version (module &optional message)
1334   "Report the first version of Perl shipping with MODULE."
1335   (interactive (list (sepia-interactive-arg 'module) t))
1336   (let* ((version
1337           (sepia-eval
1338            (format "eval { Sepia::core_version('%s') }" module)
1339            'scalar-context))
1340          (res (if version
1341                   (format "%s was first released in %s." module version)
1342                   (format "%s is not in core." module))))
1343     (when message (message "%s" res))
1344     res))
1345
1346 (defun sepia-guess-package (sub &optional file)
1347   "Guess which package SUB is defined in."
1348   (let ((defs (xref-location (xref-apropos sub))))
1349     (or (and (= (length defs) 1)
1350              (or (not file) (equal (caar defs) file))
1351              (fourth (car defs)))
1352         (and file
1353              (fourth (find-if (lambda (x) (equal (car x) file)) defs)))
1354         ;; (car (xref-file-modules file))
1355         (sepia-buffer-package))))
1356
1357 ;;;###autoload
1358 (defun sepia-apropos-module (name)
1359   "List installed modules matching a regexp."
1360   (interactive "MList modules matching regexp: ")
1361   (let ((res (xref-apropos-module name)))
1362     (if res
1363         (with-output-to-temp-buffer "*Modules*"
1364           (display-completion-list res))
1365       (message "No modules matching %s." name))))
1366
1367 ;;;###autoload
1368 (defun sepia-eval-defun ()
1369   "Re-evaluate the current function and rebuild its Xrefs."
1370   (interactive)
1371   (let (pt end beg sub res
1372            sepia-eval-package
1373            sepia-eval-file
1374            sepia-eval-line)
1375     (save-excursion
1376       (setq pt (point)
1377             end (progn (end-of-defun) (point))
1378             beg (progn (beginning-of-defun) (point)))
1379       (goto-char beg)
1380       (when (looking-at "^sub\\s +\\(.+\\_>\\)")
1381         (setq sub (match-string 1))
1382         (let ((body (buffer-substring-no-properties beg end)))
1383
1384           (setq sepia-eval-package (sepia-guess-package sub (buffer-file-name))
1385                 sepia-eval-file (buffer-file-name)
1386                 sepia-eval-line (line-number-at-pos beg)
1387                 res
1388                 (sepia-eval-raw
1389                  (if sepia-eval-defun-include-decls
1390                      (concat
1391                       (apply #'concat (xref-mod-decls sepia-eval-package))
1392                       body)
1393                      body))))))
1394     (if (cdr res)
1395         (progn
1396           (when (string-match " line \\([0-9]+\\), near \"\\([^\"]*\\)\""
1397                               (cdr res))
1398             (goto-char beg)
1399             (beginning-of-line (string-to-number (match-string 1 (cdr res))))
1400             (search-forward (match-string 2 (cdr res))
1401                             (sepia-eol-from (point)) t))
1402           (message "Error: %s" (cdr res)))
1403         (xref-redefined sub sepia-eval-package)
1404         (message "Defined %s" sub))))
1405
1406 ;;;###autoload
1407 (defun sepia-eval-expression (expr &optional list-p message-p)
1408   "Evaluate EXPR in scalar context."
1409   (interactive (list (read-string "Expression: ") current-prefix-arg t))
1410   (let ((res (sepia-eval expr (if list-p 'list-context 'scalar-context))))
1411     (when message-p (message "%s" res))
1412     res))
1413
1414 (defun sepia-extract-def (file line obj)
1415   (with-current-buffer (find-file-noselect (expand-file-name file))
1416     (save-excursion
1417       (funcall (sepia-refiner 'function) line obj)
1418       (beginning-of-line)
1419       (when (looking-at (concat "^\\s *sub\\_>.*\\_<" obj "\\_>"))
1420         (buffer-substring (point)
1421                           (progn (end-of-defun) (point)))))))
1422
1423 (defun sepia-eval-no-run (string)
1424   (let ((res (sepia-eval-raw
1425               (concat "eval q#{ BEGIN { use B; B::minus_c(); $^C=1; } do { "
1426                       string
1427                       " };BEGIN { die \"ok\\n\" }#, $@"))))
1428     (if (string-match "^ok\n" (car res))
1429         nil
1430         (car res))))
1431
1432 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1433 ;; REPL
1434
1435 (defvar sepia-eval-file nil
1436   "File in which `sepia-eval' evaluates perl expressions.")
1437 (defvar sepia-eval-line nil
1438   "Line at which `sepia-eval' evaluates perl expressions.")
1439
1440 (defun sepia-set-cwd (dir)
1441   "Set the inferior Perl process's working directory to DIR.
1442
1443 When called interactively, the current buffer's
1444 `default-directory' is used."
1445   (interactive (list (expand-file-name default-directory)))
1446   (sepia-call "Cwd::chdir" 'list-context dir))
1447
1448 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1449 ;; Doc-scanning
1450
1451 (defvar sepia-doc-map (make-hash-table :test #'equal))
1452 (defvar sepia-var-doc-map (make-hash-table :test #'equal))
1453 (defvar sepia-module-doc-map (make-hash-table :test #'equal))
1454
1455 (defun sepia-doc-scan-buffer ()
1456   (save-excursion
1457     (goto-char (point-min))
1458     (loop
1459        while (re-search-forward
1460                  "^=\\(item\\|head[2-9]\\)\\s +\\([%$&@A-Za-z_].*\\)" nil t)
1461        if
1462          (ignore-errors
1463            (let ((short (match-string 2)) longdoc)
1464               (setq short
1465                     (let ((case-fold-search nil))
1466                       (replace-regexp-in-string
1467                        "E<lt>" "<"
1468                        (replace-regexp-in-string
1469                         "E<gt>" ">"
1470                         (replace-regexp-in-string
1471                          "[A-DF-Z]<\\([^<>]+\\)>" "\\1" short)))))
1472               (while (string-match "^\\s *[A-Z]<\\(.*\\)>\\s *$" short)
1473                 (setq short (match-string 1 short)))
1474               (setq longdoc
1475                     (let ((beg (progn (forward-line 2) (point)))
1476                           (end (1- (re-search-forward "^=" nil t))))
1477                       (forward-line -1)
1478                       (goto-char beg)
1479                       (if (re-search-forward "^\\(.+\\)$" end t)
1480                           (concat short ": "
1481                                   (substring-no-properties
1482                                    (match-string 1)
1483                                    0 (position ?. (match-string 1))))
1484                           short)))
1485               (cond
1486                 ;; e.g. "$x -- this is x"
1487                 ((string-match "^[%$@]\\([A-Za-z0-9_:]+\\)\\s *--\\s *\\(.*\\)"
1488                                short)
1489                  (list 'variable (match-string-no-properties 1 short)
1490                        (or (and (equal short (match-string 1 short)) longdoc)
1491                            short)))
1492                 ;; e.g. "C<foo(BLAH)>" or "$x = $y->foo()"
1493                 ((string-match "\\([A-Za-z0-9_:]+\\)\\s *\\(\\$\\|(\\)" short)
1494                  (list 'function (match-string-no-properties 1 short)
1495                        (or (and (equal short (match-string 1 short)) longdoc)
1496                            short)))
1497                 ;; e.g. "C<$result = foo $args...>"
1498                 ((string-match "=\\s *\\([A-Za-z0-9_:]+\\)" short)
1499                  (list 'function (match-string-no-properties 1 short)
1500                        (or (and (equal short (match-string 1 short)) longdoc)
1501                            short)))
1502                 ;; e.g. "$x this is x" (note: this has to come last)
1503                 ((string-match "^[%$@]\\([^( ]+\\)" short)
1504                  (list 'variable (match-string-no-properties 1 short) longdoc)))))
1505        collect it)))
1506
1507 (defun sepia-buffer-package ()
1508   (save-excursion
1509     (or (and (re-search-backward "^\\s *package\\s +\\([^ ;]+\\)\\s *;" nil t)
1510              (match-string-no-properties 1))
1511         "main")))
1512
1513 (defun sepia-doc-update ()
1514   "Update documentation for a file.
1515
1516 This documentation, taken from \"=item\" entries in the POD, is
1517 used for eldoc feedback."
1518   (interactive)
1519   (let ((pack (ifa (sepia-buffer-package) (concat it "::") "")))
1520     (dolist (x (sepia-doc-scan-buffer))
1521       (let ((map (ecase (car x)
1522                    (function sepia-doc-map)
1523                    (variable sepia-var-doc-map))))
1524         (puthash (second x) (third x) map)
1525         (puthash (concat pack (second x)) (third x) map)))))
1526
1527 (defun sepia-looks-like-module (obj)
1528   (let (case-fold-search)
1529     (or (string-match
1530          (eval-when-compile (regexp-opt '("strict" "vars" "warnings" "lib")))
1531          obj)
1532         (and
1533          (string-match "^\\([A-Z][A-Za-z0-9]*::\\)*[A-Z]+[A-Za-z0-9]+\\sw*$" obj)
1534          (xref-apropos-module obj)))))
1535
1536 (defun sepia-describe-object (thing)
1537   "Display documentation for `thing', like ``describe-function'' for elisp."
1538   (interactive
1539    (let ((id (sepia-ident-at-point)))
1540      (when (string= (cadr id) "")
1541        (setq id (sepia-ident-before-point)))
1542      (if (car id)
1543          (list id)
1544        (cdr id))))
1545   (cond
1546    ((listp thing)
1547     (setq thing (format "%c%s" (car thing) (cadr thing)))
1548     (with-current-buffer (get-buffer-create "*sepia-help*")
1549       (let ((inhibit-read-only t))
1550         (erase-buffer)
1551         (shell-command (concat "perldoc -v " (shell-quote-argument thing))
1552                        (current-buffer))
1553         (view-mode 1)
1554         (goto-char (point-min)))
1555       (unless (looking-at "No documentation for")
1556         (pop-to-buffer "*sepia-help*" t))))
1557    ((gethash thing sepia-perl-builtins)
1558     (with-current-buffer (get-buffer-create "*sepia-help*")
1559       (let ((inhibit-read-only t))
1560         (erase-buffer)
1561         (shell-command (concat "perldoc -f " thing) (current-buffer))
1562         (view-mode 1)
1563         (goto-char (point-min))))
1564     (pop-to-buffer "*sepia-help*" t))))
1565
1566 (defun sepia-symbol-info (&optional obj type)
1567   "Eldoc function for `sepia-mode'.
1568
1569 Looks in `sepia-doc-map' and `sepia-var-doc-map', then tries
1570 calling `cperl-describe-perl-symbol'."
1571   (unless obj
1572     (multiple-value-bind (ty ob) (sepia-ident-at-point)
1573       (setq obj (if (consp ob) (car ob) ob)
1574             type ty)))
1575   (if obj
1576       (or (gethash obj (ecase (or type ?&)
1577                          (?& sepia-doc-map)
1578                          ((?$ ?@ ?%) sepia-var-doc-map)
1579                          (nil sepia-module-doc-map)
1580                          (?* sepia-module-doc-map)
1581                          (t (error "sepia-symbol-info: %s" type))))
1582           ;; Loathe cperl a bit.
1583           (flet ((message (&rest blah) (apply #'format blah)))
1584             (let* (case-fold-search
1585                    (cperl-message-on-help-error nil)
1586                    (hlp (car (save-excursion
1587                                (cperl-describe-perl-symbol
1588                                 (if (member type '(?$ ?@ ?%))
1589                                     (format "%c%s" type obj)
1590                                   obj))))))
1591               (if hlp
1592                   (progn
1593                     ;; cperl's docstrings are too long.
1594                     (setq hlp (replace-regexp-in-string "\\s \\{2,\\}\\|\t" "  " hlp))
1595                     (if (> (length hlp) 75)
1596                         (concat (substring hlp 0 72) "...")
1597                         hlp))
1598                   ;; Try to see if it's a module
1599                   (if (and
1600                        (let ((bol (save-excursion (beginning-of-line)
1601                                                   (point))))
1602                          (looking-back " *\\(?:use\\|require\\|package\\|no\\)\\s +[^ ]*" bol))
1603                        (sepia-looks-like-module obj))
1604                       (sepia-core-version obj)
1605                       ""))))
1606       "")))
1607
1608 (defun sepia-install-eldoc ()
1609   "Install Sepia hooks for eldoc support."
1610   (interactive)
1611   (require 'eldoc)
1612   (set-variable 'eldoc-documentation-function 'sepia-symbol-info t)
1613   (if cperl-lazy-installed (cperl-lazy-unstall))
1614   (eldoc-mode 1)
1615   (set-variable 'eldoc-idle-delay 1.0 t))
1616
1617 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1618 ;; Error jump:
1619
1620 (defun sepia-extract-next-warning (pos &optional end)
1621   (catch 'foo
1622     (while (re-search-forward "^\\(.+\\) at \\(.+?\\) line \\([0-9]+\\)"
1623                               end t)
1624       (unless (string= "(eval " (substring (match-string 2) 0 6))
1625         (throw 'foo (list (match-string 2)
1626                           (string-to-number (match-string 3))
1627                           (match-string 1)))))))
1628
1629 (defun sepia-goto-error-at (pos)
1630   "Visit the source of the error on line at point."
1631   (interactive "d")
1632   (ifa (sepia-extract-next-warning (sepia-bol-from pos) (sepia-eol-from pos))
1633        (destructuring-bind (file line msg) it
1634          (find-file file)
1635          (goto-line line)
1636          (message "%s" msg))
1637        (error "No error to find.")))
1638
1639 (defun sepia-display-errors (beg end)
1640   "Display source causing errors in current buffer from BEG to END."
1641   (interactive "r")
1642   (goto-char beg)
1643   (let ((msgs nil))
1644     (loop for w = (sepia-extract-next-warning (sepia-bol-from (point)) end)
1645        while w
1646        do (destructuring-bind (file line msg) w
1647             (push (format "%s:%d:%s\n" (abbreviate-file-name file) line msg)
1648                   msgs)))
1649     (erase-buffer)
1650     (goto-char (point-min))
1651     (mapcar #'insert (nreverse msgs))
1652     (goto-char (point-min))
1653     (grep-mode)))
1654
1655 (defun sepia-lisp-to-perl (thing)
1656   "Convert elisp data structure to Perl."
1657   (cond
1658     ((null thing) "undef")
1659     ((symbolp thing)
1660      (let ((pname (substitute ?_ ?- (symbol-name thing)))
1661            (type (string-to-char (symbol-name thing))))
1662        (if (member type '(?% ?$ ?@ ?*))
1663            pname
1664            (concat "\\*" pname))))
1665     ((stringp thing) (format "%S" (substring-no-properties thing 0)))
1666     ((integerp thing) (format "%d" thing))
1667     ((numberp thing) (format "%g" thing))
1668     ;; Perl expression
1669     ((and (consp thing) (eq (car thing) 'expr))
1670      (cdr thing))        ; XXX -- need quoting??
1671     ((and (consp thing) (not (consp (cdr thing))))
1672      (concat (sepia-lisp-to-perl (car thing)) " => "
1673              (sepia-lisp-to-perl (cdr thing))))
1674     ;; list
1675     ((or (not (consp (car thing)))
1676          (listp (cdar thing)))
1677      (concat "[" (mapconcat #'sepia-lisp-to-perl thing ", ") "]"))
1678     ;; hash table
1679     (t
1680      (concat "{" (mapconcat #'sepia-lisp-to-perl thing ", ") "}"))))
1681
1682 (defun sepia-init-perl-builtins ()
1683   (setq sepia-perl-builtins (make-hash-table :test #'equal))
1684   (dolist (s '("abs"
1685 "accept"
1686 "alarm"
1687 "atan2"
1688 "bind"
1689 "binmode"
1690 "bless"
1691 "caller"
1692 "chdir"
1693 "chmod"
1694 "chomp"
1695 "chop"
1696 "chown"
1697 "chr"
1698 "chroot"
1699 "close"
1700 "closedir"
1701 "connect"
1702 "continue"
1703 "cos"
1704 "crypt"
1705 "dbmclose"
1706 "dbmopen"
1707 "defined"
1708 "delete"
1709 "die"
1710 "dump"
1711 "each"
1712 "endgrent"
1713 "endhostent"
1714 "endnetent"
1715 "endprotoent"
1716 "endpwent"
1717 "endservent"
1718 "eof"
1719 "eval"
1720 "exec"
1721 "exists"
1722 "exit"
1723 "exp"
1724 "fcntl"
1725 "fileno"
1726 "flock"
1727 "fork"
1728 "format"
1729 "formline"
1730 "getc"
1731 "getgrent"
1732 "getgrgid"
1733 "getgrnam"
1734 "gethostbyaddr"
1735 "gethostbyname"
1736 "gethostent"
1737 "getlogin"
1738 "getnetbyaddr"
1739 "getnetbyname"
1740 "getnetent"
1741 "getpeername"
1742 "getpgrp"
1743 "getppid"
1744 "getpriority"
1745 "getprotobyname"
1746 "getprotobynumber"
1747 "getprotoent"
1748 "getpwent"
1749 "getpwnam"
1750 "getpwuid"
1751 "getservbyname"
1752 "getservbyport"
1753 "getservent"
1754 "getsockname"
1755 "getsockopt"
1756 "glob"
1757 "gmtime"
1758 "goto"
1759 "grep"
1760 "hex"
1761 "import"
1762 "index"
1763 "int"
1764 "ioctl"
1765 "join"
1766 "keys"
1767 "kill"
1768 "last"
1769 "lc"
1770 "lcfirst"
1771 "length"
1772 "link"
1773 "listen"
1774 "local"
1775 "localtime"
1776 "log"
1777 "lstat"
1778 "map"
1779 "mkdir"
1780 "msgctl"
1781 "msgget"
1782 "msgrcv"
1783 "msgsnd"
1784 "next"
1785 "oct"
1786 "open"
1787 "opendir"
1788 "ord"
1789 "pack"
1790 "package"
1791 "pipe"
1792 "pop"
1793 "pos"
1794 "print"
1795 "printf"
1796 "prototype"
1797 "push"
1798 "quotemeta"
1799 "rand"
1800 "read"
1801 "readdir"
1802 "readline"
1803 "readlink"
1804 "readpipe"
1805 "recv"
1806 "redo"
1807 "ref"
1808 "rename"
1809 "require"
1810 "reset"
1811 "return"
1812 "reverse"
1813 "rewinddir"
1814 "rindex"
1815 "rmdir"
1816 "scalar"
1817 "seek"
1818 "seekdir"
1819 "select"
1820 "semctl"
1821 "semget"
1822 "semop"
1823 "send"
1824 "setgrent"
1825 "sethostent"
1826 "setnetent"
1827 "setpgrp"
1828 "setpriority"
1829 "setprotoent"
1830 "setpwent"
1831 "setservent"
1832 "setsockopt"
1833 "shift"
1834 "shmctl"
1835 "shmget"
1836 "shmread"
1837 "shmwrite"
1838 "shutdown"
1839 "sin"
1840 "sleep"
1841 "socket"
1842 "socketpair"
1843 "sort"
1844 "splice"
1845 "split"
1846 "sprintf"
1847 "sqrt"
1848 "srand"
1849 "stat"
1850 "study"
1851 "sub"
1852 "sub*"
1853 "substr"
1854 "symlink"
1855 "syscall"
1856 "sysopen"
1857 "sysread"
1858 "sysseek"
1859 "system"
1860 "syswrite"
1861 "tell"
1862 "telldir"
1863 "tie"
1864 "tied"
1865 "time"
1866 "times"
1867 "truncate"
1868 "uc"
1869 "ucfirst"
1870 "umask"
1871 "undef"
1872 "unlink"
1873 "unpack"
1874 "unshift"
1875 "untie"
1876 "utime"
1877 "values"
1878 "vec"
1879 "wait"
1880 "waitpid"
1881 "wantarray"
1882 "warn"
1883 "write"
1884 ))
1885         (puthash s t sepia-perl-builtins)))
1886
1887 (provide 'sepia)
1888 ;;; sepia.el ends here