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