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