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