1158 lines
48 KiB
EmacsLisp
1158 lines
48 KiB
EmacsLisp
|
;;; ess-utils.el --- General Emacs utility functions used by ESS
|
|||
|
|
|||
|
;; Copyright (C) 1998--2010 A.J. Rossini, Richard M. Heiberger, Martin
|
|||
|
;; Maechler, Kurt Hornik, Rodney Sparapani, and Stephen Eglen.
|
|||
|
;; Copyright (C) 2011--2012 A.J. Rossini, Richard M. Heiberger, Martin Maechler,
|
|||
|
;; Kurt Hornik, Rodney Sparapani, Stephen Eglen and Vitalie Spinu.
|
|||
|
|
|||
|
;; Author: Martin Maechler <maechler@stat.math.ethz.ch>
|
|||
|
;; Created: 9 Sept 1998
|
|||
|
;; Maintainer: ESS-core <ESS-core@r-project.org>
|
|||
|
|
|||
|
;; This file is part of ESS (Emacs Speaks Statistics).
|
|||
|
|
|||
|
;; This file is free software; you can redistribute it and/or modify
|
|||
|
;; it under the terms of the GNU General Public License as published by
|
|||
|
;; the Free Software Foundation; either version 2, or (at your option)
|
|||
|
;; any later version.
|
|||
|
|
|||
|
;; This file is distributed in the hope that it will be useful,
|
|||
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|||
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|||
|
;; GNU General Public License for more details.
|
|||
|
|
|||
|
;; A copy of the GNU General Public License is available at
|
|||
|
;; http://www.r-project.org/Licenses/
|
|||
|
|
|||
|
;;; Code:
|
|||
|
|
|||
|
(eval-when-compile
|
|||
|
(require 'tramp)
|
|||
|
(require 'cl))
|
|||
|
|
|||
|
(defun ess-inside-string-or-comment-p (&optional pos)
|
|||
|
"Return non-nil if POSition [defaults to (point)] is inside string or comment
|
|||
|
(according to syntax)."
|
|||
|
;;FIXME (defun ess-calculate-indent ..) can do that ...
|
|||
|
(interactive)
|
|||
|
(setq pos (or pos (point)))
|
|||
|
(let ((ppss (syntax-ppss pos)))
|
|||
|
(or (car (setq ppss (nthcdr 3 ppss)))
|
|||
|
(car (setq ppss (cdr ppss)))
|
|||
|
(nth 3 ppss))))
|
|||
|
|
|||
|
|
|||
|
(defun ess-inside-string-p (&optional pos)
|
|||
|
"Return non-nil if point is inside string (according to syntax)."
|
|||
|
(interactive)
|
|||
|
;; when narrowing the buffer in iESS the ppss cahce is screwed:( But it is
|
|||
|
;; very fast, so don't bother for now.
|
|||
|
(let ((pps (syntax-ppss pos)))
|
|||
|
(nth 3 pps))
|
|||
|
;; (nth 3 (parse-partial-sexp (point-min) pos))
|
|||
|
)
|
|||
|
|
|||
|
(defun ess-inside-comment-p (&optional pos)
|
|||
|
"Return non-nil if point is inside string (according to syntax)."
|
|||
|
(interactive)
|
|||
|
(setq pos (or pos (point)))
|
|||
|
(save-excursion
|
|||
|
(or (when font-lock-mode ;; this is a shortcut (works well usually)
|
|||
|
(let ((face (get-char-property pos 'face)))
|
|||
|
(eq 'font-lock-comment-face face)))
|
|||
|
(nth 4 (parse-partial-sexp (progn (goto-char pos) (point-at-bol)) pos)))))
|
|||
|
|
|||
|
(defun ess-inside-brackets-p (&optional pos curly?)
|
|||
|
"Return t if position POS is inside brackets.
|
|||
|
POS defaults to point if no value is given. If curly? is non nil
|
|||
|
also return t if inside curly brackets."
|
|||
|
(save-excursion
|
|||
|
(let ((ppss (syntax-ppss pos))
|
|||
|
(r nil))
|
|||
|
(while (and (> (nth 0 ppss) 0)
|
|||
|
(not r))
|
|||
|
(goto-char (nth 1 ppss))
|
|||
|
(when (or (char-equal ?\[ (char-after))
|
|||
|
(and curly?
|
|||
|
(char-equal ?\{ (char-after))))
|
|||
|
(setq r t))
|
|||
|
(setq ppss (syntax-ppss)))
|
|||
|
r)))
|
|||
|
|
|||
|
(defun ess--extract-default-fl-keywords (keywords)
|
|||
|
"Extract the t-keywords from `ess-font-lock-keywords'."
|
|||
|
(delq nil (mapcar (lambda (c)
|
|||
|
(when (cdr c) (symbol-value (car c))))
|
|||
|
(if (symbolp keywords)
|
|||
|
(symbol-value keywords)
|
|||
|
keywords))))
|
|||
|
|
|||
|
(defun ess-font-lock-toggle-keyword (keyword)
|
|||
|
(interactive
|
|||
|
(list (intern (ess-completing-read
|
|||
|
"Keyword to toggle"
|
|||
|
(mapcar (lambda (el) (symbol-name (car el)))
|
|||
|
(symbol-value ess-font-lock-keywords))
|
|||
|
nil t))))
|
|||
|
(let* ((kwds (symbol-value (if (eq major-mode 'ess-mode)
|
|||
|
ess-font-lock-keywords
|
|||
|
inferior-ess-font-lock-keywords)))
|
|||
|
(kwd (assoc keyword kwds)))
|
|||
|
(unless kwd (error "Keyword %s was not found in (inferior-)ess-font-lock-keywords list" keyword))
|
|||
|
(if (cdr kwd)
|
|||
|
(setcdr kwd nil)
|
|||
|
(setcdr kwd t))
|
|||
|
(let ((mode major-mode)
|
|||
|
(dialect ess-dialect)
|
|||
|
(fld (ess--extract-default-fl-keywords kwds)))
|
|||
|
;; refresh font-lock defaults in all necessary buffers
|
|||
|
(mapc (lambda (b)
|
|||
|
(with-current-buffer b
|
|||
|
(when (and (eq major-mode mode)
|
|||
|
(eq ess-dialect dialect))
|
|||
|
(setcar font-lock-defaults fld)
|
|||
|
(font-lock-refresh-defaults))))
|
|||
|
(buffer-list)))))
|
|||
|
|
|||
|
|
|||
|
(defun ess--generate-font-lock-submenu (menu)
|
|||
|
"Internal, used to generate ESS font-lock submenu"
|
|||
|
(append (mapcar (lambda (el)
|
|||
|
`[,(symbol-name (car el))
|
|||
|
(lambda () (interactive)
|
|||
|
(ess-font-lock-toggle-keyword ',(car el)))
|
|||
|
:style toggle
|
|||
|
:enable t
|
|||
|
:selected ,(cdr el)])
|
|||
|
(cond ((eq major-mode 'ess-mode)
|
|||
|
(symbol-value ess-font-lock-keywords))
|
|||
|
((eq major-mode 'inferior-ess-mode)
|
|||
|
(symbol-value inferior-ess-font-lock-keywords))))
|
|||
|
(list "-----"
|
|||
|
["Save to custom" (lambda () (interactive)
|
|||
|
(let ((kwd (if (eq major-mode 'ess-mode)
|
|||
|
ess-font-lock-keywords
|
|||
|
inferior-ess-font-lock-keywords)))
|
|||
|
(customize-save-variable kwd (symbol-value kwd)))) t])))
|
|||
|
|
|||
|
|
|||
|
|
|||
|
(defun ess--generate-eval-visibly-submenu (menu)
|
|||
|
'(["yes" (lambda () (interactive) (setq ess-eval-visibly t))
|
|||
|
:style radio :enable t :selected (eq ess-eval-visibly t)]
|
|||
|
["nowait" (lambda () (interactive) (setq ess-eval-visibly 'nowait))
|
|||
|
:style radio :enable t :selected (eq ess-eval-visibly 'nowait) ]
|
|||
|
["no" (lambda () (interactive) (setq ess-eval-visibly nil))
|
|||
|
:style radio :enable t :selected (eq ess-eval-visibly nil) ]))
|
|||
|
|
|||
|
|
|||
|
(defun ess-quote-special-chars (string)
|
|||
|
(replace-regexp-in-string
|
|||
|
"\"" "\\\\\\&"
|
|||
|
(replace-regexp-in-string ;; replace backslashes
|
|||
|
"\\\\" "\\\\" string nil t)))
|
|||
|
|
|||
|
;; simple alternative to ess-read-object-name-default of ./ess-inf.el :
|
|||
|
;; is "wrongly" returning "p1" for word "p1.part2" :
|
|||
|
(defun ess-extract-word-name ()
|
|||
|
"Get the word you're on (cheap algorithm). Use `ess-read-object-name-default'
|
|||
|
for a better but slower version."
|
|||
|
(save-excursion
|
|||
|
(re-search-forward "\\<\\w+\\>" nil t)
|
|||
|
(buffer-substring (match-beginning 0) (match-end 0))))
|
|||
|
|
|||
|
(defun ess-rep-regexp (regexp to-string &optional fixedcase literal verbose)
|
|||
|
"Instead of (replace-regexp..) -- do NOT replace in strings or comments.
|
|||
|
If FIXEDCASE is non-nil, do *not* alter case of replacement text.
|
|||
|
If LITERAL is non-nil, do *not* treat `\\' as special.
|
|||
|
If VERBOSE is non-nil, (message ..) about replacements."
|
|||
|
(let ((case-fold-search (and case-fold-search
|
|||
|
(not fixedcase))); t <==> ignore case in search
|
|||
|
(ppt (point)); previous point
|
|||
|
(p))
|
|||
|
(while (and (setq p (re-search-forward regexp nil t))
|
|||
|
(< ppt p))
|
|||
|
(setq ppt p)
|
|||
|
(cond ((not (ess-inside-string-or-comment-p (1- p)))
|
|||
|
(if verbose
|
|||
|
(let ((beg (match-beginning 0)))
|
|||
|
(message "buffer in (match-beg.,p)=(%d,%d) is '%s'"
|
|||
|
beg p (buffer-substring beg p))))
|
|||
|
(replace-match to-string fixedcase literal)
|
|||
|
;;or (if verbose (setq pl (append pl (list p))))
|
|||
|
)))
|
|||
|
;;or (if (and verbose pl)
|
|||
|
;;or (message "s/%s/%s/ at %s" regexp to-string pl))
|
|||
|
) )
|
|||
|
|
|||
|
(defun ess-replace-regexp-dump-to-src
|
|||
|
(regexp to-string &optional dont-query verbose ensure-mode)
|
|||
|
"Depending on dont-query, call `ess-rep-regexp' or `query-replace-regexp'
|
|||
|
from the beginning of the buffer."
|
|||
|
(save-excursion
|
|||
|
(if (and ensure-mode
|
|||
|
(not (equal major-mode 'ess-mode)))
|
|||
|
(ess-mode))
|
|||
|
(goto-char (point-min))
|
|||
|
(if dont-query
|
|||
|
(ess-rep-regexp regexp to-string nil nil verbose)
|
|||
|
(query-replace-regexp regexp to-string nil))))
|
|||
|
|
|||
|
|
|||
|
(defun ess-revert-wisely ()
|
|||
|
"Revert from disk if file and buffer last modification times are different."
|
|||
|
(interactive)
|
|||
|
|
|||
|
; whether or not a revert is needed, force load local variables
|
|||
|
; for example, suppose that you change the local variables and then
|
|||
|
; save the file, a revert is unneeded, but a force load is
|
|||
|
(hack-local-variables)
|
|||
|
|
|||
|
(if (not (verify-visited-file-modtime (current-buffer))) (progn
|
|||
|
(let ((ess-temp-store-point (point)))
|
|||
|
(revert-buffer t t)
|
|||
|
(goto-char ess-temp-store-point))
|
|||
|
t)
|
|||
|
nil))
|
|||
|
|
|||
|
|
|||
|
(defun ess-space-around (word &optional from verbose)
|
|||
|
"Replace-regexp .. ensuring space around all occurences of WORD,
|
|||
|
starting from FROM {defaults to (point)}."
|
|||
|
(interactive "d\nP"); Defaults: point and prefix (C-u)
|
|||
|
(save-excursion
|
|||
|
(goto-char from)
|
|||
|
(ess-rep-regexp (concat "\\([^ \t\n]\\)\\(\\<" word "\\>\\)")
|
|||
|
"\\1 \\2" nil nil verbose)
|
|||
|
(goto-char from)
|
|||
|
(ess-rep-regexp (concat "\\(\\<" word "\\>\\)\\([^ \t\n]\\)")
|
|||
|
"\\1 \\2" nil nil verbose)
|
|||
|
)
|
|||
|
)
|
|||
|
|
|||
|
(defun ess-time-string (&optional clock)
|
|||
|
"Returns a string for use as a timestamp. + hr:min if CLOCK is non-nil,
|
|||
|
like \"13 Mar 1992\". Redefine to taste."
|
|||
|
(format-time-string (concat "%e %b %Y" (if clock ", %H:%M"))))
|
|||
|
|
|||
|
|
|||
|
;;- From: friedman@gnu.ai.mit.edu (Noah Friedman)
|
|||
|
;;- Date: 12 Feb 1995 21:30:56 -0500
|
|||
|
;;- Newsgroups: gnu.emacs.sources
|
|||
|
;;- Subject: nuke-trailing-whitespace
|
|||
|
;;-
|
|||
|
;;- This is too trivial to make into a big todo with comments and copyright
|
|||
|
;;- notices whose length exceed the size of the actual code, so consider it
|
|||
|
;;- public domain. Its purpose is along similar lines to that of
|
|||
|
;;- `require-final-newline', which is built in. I hope the names make it
|
|||
|
;;- obvious.
|
|||
|
|
|||
|
;; (add-hook 'write-file-hooks 'nuke-trailing-whitespace)
|
|||
|
;;or at least
|
|||
|
;; (add-hook 'ess-mode-hook
|
|||
|
;; (lambda ()
|
|||
|
;; (add-hook 'local-write-file-hooks 'nuke-trailing-whitespace)))
|
|||
|
|
|||
|
(defvar ess-nuke-trailing-whitespace-p nil;disabled by default 'ask
|
|||
|
"*[Dis]activates (ess-nuke-trailing-whitespace).
|
|||
|
Disabled if `nil'; if `t', it works unconditionally, otherwise,
|
|||
|
the user is queried.
|
|||
|
Note that setting the default to `t' may not be a good idea when you edit
|
|||
|
binary files!")
|
|||
|
|
|||
|
;;; MM: Newer Emacsen now have delete-trailing-whitespace
|
|||
|
;;; -- but no customization like nuke-trailing-whitespace-p ..
|
|||
|
(defun ess-nuke-trailing-whitespace ()
|
|||
|
"Nuke all trailing whitespace in the buffer.
|
|||
|
Whitespace in this case is just spaces or tabs.
|
|||
|
This is a useful function to put on write-file-hooks.
|
|||
|
|
|||
|
If the variable `ess-nuke-trailing-whitespace-p' is `nil', this function is
|
|||
|
disabled. If `t', unreservedly strip trailing whitespace.
|
|||
|
If not `nil' and not `t', query for each instance."
|
|||
|
(interactive)
|
|||
|
(let ((bname (buffer-name)))
|
|||
|
(cond ((or
|
|||
|
(string= major-mode "rmail-mode")
|
|||
|
(string= bname "RMAIL")
|
|||
|
nil)); do nothing..
|
|||
|
|
|||
|
(t
|
|||
|
(and (not buffer-read-only)
|
|||
|
ess-nuke-trailing-whitespace-p
|
|||
|
(save-match-data
|
|||
|
(save-excursion
|
|||
|
(save-restriction
|
|||
|
(widen)
|
|||
|
(goto-char (point-min))
|
|||
|
(cond ((eq ess-nuke-trailing-whitespace-p t)
|
|||
|
(while (re-search-forward "[ \t]+$" (point-max) t)
|
|||
|
(delete-region (match-beginning 0)
|
|||
|
(match-end 0))))
|
|||
|
(t
|
|||
|
(query-replace-regexp "[ \t]+$" "")))))))))
|
|||
|
;; always return nil, in case this is on write-file-hooks.
|
|||
|
nil))
|
|||
|
|
|||
|
(defun ess-kermit-get (&optional ess-file-arg ess-dir-arg)
|
|||
|
"Get a file with Kermit. WARNING: Experimental! From your *shell*
|
|||
|
buffer, start kermit and then log in to the remote machine. Open
|
|||
|
a file that starts with `ess-kermit-prefix'. From that buffer,
|
|||
|
execute this command. It will retrieve a file from the remote
|
|||
|
directory that you specify with the same name, but without the
|
|||
|
`ess-kermit-prefix'."
|
|||
|
|
|||
|
(interactive)
|
|||
|
|
|||
|
;; (save-match-data
|
|||
|
(let ((ess-temp-file (if ess-file-arg ess-file-arg (buffer-name)))
|
|||
|
(ess-temp-file-remote-directory ess-dir-arg))
|
|||
|
|
|||
|
(if (string-equal ess-kermit-prefix (substring ess-temp-file 0 1))
|
|||
|
(progn
|
|||
|
;; I think there is a bug in the buffer-local variable handling in GNU Emacs 21.3
|
|||
|
;; Setting ess-kermit-remote-directory every time is somehow resetting it to the
|
|||
|
;; default on the second pass. So, here's a temporary work-around. It will fail
|
|||
|
;; if you change the default, so maybe this variable should not be customizable.
|
|||
|
;; In any case, there is also trouble with local variables in XEmacs 21.4.9 and
|
|||
|
;; 21.4.10. XEmacs 21.4.8 is fine.
|
|||
|
(if ess-temp-file-remote-directory
|
|||
|
(setq ess-kermit-remote-directory ess-temp-file-remote-directory)
|
|||
|
|
|||
|
(if (string-equal "." ess-kermit-remote-directory)
|
|||
|
(setq ess-kermit-remote-directory (read-string "Remote directory to transfer file from: "
|
|||
|
ess-kermit-remote-directory))))
|
|||
|
|
|||
|
(setq ess-temp-file-remote-directory ess-kermit-remote-directory)
|
|||
|
;; (setq ess-temp-file (substring ess-temp-file (match-end 0)))
|
|||
|
(ess-sas-goto-shell)
|
|||
|
(insert "cd " ess-temp-file-remote-directory "; " ess-kermit-command " -s "
|
|||
|
(substring ess-temp-file 1) " -a " ess-temp-file)
|
|||
|
(comint-send-input)
|
|||
|
;; (insert (read-string "Press Return to connect to Kermit: " nil nil "\C-\\c"))
|
|||
|
;; (comint-send-input)
|
|||
|
;; (insert (read-string "Press Return when Kermit is ready to recieve: " nil nil
|
|||
|
;; (concat "receive ]" ess-sas-temp-file)))
|
|||
|
;; (comint-send-input)
|
|||
|
;; (insert (read-string "Press Return when transfer is complete: " nil nil "c"))
|
|||
|
;; (comint-send-input)
|
|||
|
(insert (read-string "Press Return when shell is ready: "))
|
|||
|
(comint-send-input)
|
|||
|
(switch-to-buffer (find-buffer-visiting ess-temp-file))
|
|||
|
(ess-revert-wisely)
|
|||
|
))))
|
|||
|
|
|||
|
(defun ess-kermit-send ()
|
|||
|
"Send a file with Kermit. WARNING: Experimental! From
|
|||
|
a file that starts with `ess-kermit-prefix',
|
|||
|
execute this command. It will transfer this file to the remote
|
|||
|
directory with the same name, but without the `ess-kermit-prefix'."
|
|||
|
|
|||
|
(interactive)
|
|||
|
|
|||
|
;; (save-match-data
|
|||
|
(let ((ess-temp-file (expand-file-name (buffer-name)))
|
|||
|
(ess-temp-file-remote-directory nil))
|
|||
|
|
|||
|
(if (string-equal ess-kermit-prefix (substring (file-name-nondirectory ess-temp-file) 0 1))
|
|||
|
(progn
|
|||
|
;; I think there is a bug in the buffer-local variable handling in GNU Emacs 21.3
|
|||
|
;; Setting ess-kermit-remote-directory every time is somehow resetting it to the
|
|||
|
;; default on the second pass. Here's a temporary work-around. It will fail
|
|||
|
;; if you change the default, so maybe this variable should not be customizable.
|
|||
|
;; In any case, there is also trouble with local variables in XEmacs 21.4.9 and
|
|||
|
;; 21.4.10. XEmacs 21.4.8 is fine.
|
|||
|
(if (string-equal "." ess-kermit-remote-directory)
|
|||
|
(setq ess-kermit-remote-directory (read-string "Remote directory to transfer file to: "
|
|||
|
ess-kermit-remote-directory)))
|
|||
|
|
|||
|
(setq ess-temp-file-remote-directory ess-kermit-remote-directory)
|
|||
|
|
|||
|
;; (setq ess-temp-file (substring ess-temp-file (match-end 0)))
|
|||
|
(ess-sas-goto-shell)
|
|||
|
(insert "cd " ess-temp-file-remote-directory "; " ess-kermit-command " -a "
|
|||
|
(substring (file-name-nondirectory ess-temp-file) 1) " -g " ess-temp-file)
|
|||
|
(comint-send-input)
|
|||
|
;; (insert (read-string "Press Return to connect to Kermit: " nil nil "\C-\\c"))
|
|||
|
;; (comint-send-input)
|
|||
|
;; (insert (read-string "Press Return when Kermit is ready to recieve: " nil nil
|
|||
|
;; (concat "receive ]" ess-sas-temp-file)))
|
|||
|
;; (comint-send-input)
|
|||
|
;; (insert (read-string "Press Return when transfer is complete: " nil nil "c"))
|
|||
|
;; (comint-send-input)
|
|||
|
(insert (read-string "Press Return when shell is ready: "))
|
|||
|
(comint-send-input)
|
|||
|
(switch-to-buffer (find-buffer-visiting ess-temp-file))
|
|||
|
(ess-revert-wisely)
|
|||
|
))))
|
|||
|
|
|||
|
(defun ess-search-except (regexp &optional except backward)
|
|||
|
"Search for a regexp, store as match 1, optionally ignore
|
|||
|
strings that match exceptions."
|
|||
|
(interactive)
|
|||
|
|
|||
|
(let ((continue t) (exit nil))
|
|||
|
|
|||
|
(while continue
|
|||
|
(if (or (and backward (search-backward-regexp regexp nil t))
|
|||
|
(and (not backward) (search-forward-regexp regexp nil t)))
|
|||
|
(progn
|
|||
|
(setq exit (match-string 1))
|
|||
|
(setq continue (and except (string-match except exit)))
|
|||
|
(if continue (setq exit nil)))
|
|||
|
;;else
|
|||
|
(setq continue nil))
|
|||
|
)
|
|||
|
|
|||
|
exit))
|
|||
|
|
|||
|
(defun ess-save-and-set-local-variables ()
|
|||
|
"If buffer was modified, save file and set Local Variables if defined.
|
|||
|
Return t if buffer was modified, nil otherwise."
|
|||
|
(interactive)
|
|||
|
|
|||
|
(let ((ess-temp-point (point))
|
|||
|
(ess-temp-return-value (buffer-modified-p)))
|
|||
|
;; if buffer has changed, save buffer now (before potential revert)
|
|||
|
(if ess-temp-return-value (save-buffer))
|
|||
|
|
|||
|
;; If Local Variables are defined, update them now
|
|||
|
;; since they may have changed since the last revert
|
|||
|
;; (save-excursion
|
|||
|
(beginning-of-line -1)
|
|||
|
(save-match-data
|
|||
|
(if (search-forward "End:" nil t) (revert-buffer t t)))
|
|||
|
;; save-excursion doesn't save point in the presence of a revert
|
|||
|
;; so you need to do it yourself
|
|||
|
(goto-char ess-temp-point)
|
|||
|
|
|||
|
ess-temp-return-value))
|
|||
|
|
|||
|
(defun ess-get-file-or-buffer (file-or-buffer)
|
|||
|
"Return file-or-buffer if it is a buffer; otherwise return the buffer
|
|||
|
associated with the file which must be qualified by it's path; if the
|
|||
|
buffer does not exist, return nil."
|
|||
|
(interactive)
|
|||
|
|
|||
|
(if file-or-buffer
|
|||
|
(if (bufferp file-or-buffer) file-or-buffer
|
|||
|
(find-buffer-visiting file-or-buffer))))
|
|||
|
|
|||
|
(defun ess-set-local-variables (alist &optional file-or-buffer)
|
|||
|
"Set local variables from ALIST in current buffer; if file-or-buffer
|
|||
|
is specified, perform action in that buffer."
|
|||
|
(interactive)
|
|||
|
(if file-or-buffer (set-buffer (ess-get-file-or-buffer file-or-buffer)))
|
|||
|
|
|||
|
(mapcar (lambda (pair)
|
|||
|
(make-local-variable (car pair))
|
|||
|
(set (car pair) (eval (cdr pair))))
|
|||
|
alist))
|
|||
|
|
|||
|
(defun ess-clone-local-variables (from-file-or-buffer
|
|||
|
&optional to-file-or-buffer)
|
|||
|
"Clone local variables from one buffer to another buffer."
|
|||
|
(interactive)
|
|||
|
(ess-set-local-variables
|
|||
|
(ess-sas-create-local-variables-alist from-file-or-buffer)
|
|||
|
to-file-or-buffer))
|
|||
|
|
|||
|
(defun ess-return-list (ess-arg)
|
|||
|
"Given an item, if it is a list return it, else return item in a list."
|
|||
|
(if (listp ess-arg) ess-arg (list ess-arg)))
|
|||
|
|
|||
|
(defun ess-find-exec (ess-root-arg ess-root-dir)
|
|||
|
"Given a root directory and the root of an executable file name,
|
|||
|
find it's full name and path, if it exists, anywhere in the sub-tree."
|
|||
|
(let* ((ess-tmp-dirs (directory-files ess-root-dir t "^[^.]"))
|
|||
|
(ess-tmp-return (ess-find-exec-completions ess-root-arg ess-root-dir))
|
|||
|
(ess-tmp-dir nil))
|
|||
|
|
|||
|
(while ess-tmp-dirs
|
|||
|
(setq ess-tmp-dir (car ess-tmp-dirs)
|
|||
|
ess-tmp-dirs (cdr ess-tmp-dirs))
|
|||
|
(if (file-accessible-directory-p ess-tmp-dir)
|
|||
|
(setq ess-tmp-return
|
|||
|
(nconc ess-tmp-return
|
|||
|
(ess-find-exec ess-root-arg ess-tmp-dir)))))
|
|||
|
ess-tmp-return))
|
|||
|
|
|||
|
(defun ess-find-exec-completions (ess-root-arg &optional ess-exec-dir)
|
|||
|
"Given the root of an executable file name, find all possible completions.
|
|||
|
Search for the executables in ESS-EXEC-DIR (which defaults to
|
|||
|
`exec-path' if no value is given)."
|
|||
|
(let* ((ess-exec-path
|
|||
|
(if ess-exec-dir (ess-return-list ess-exec-dir) exec-path))
|
|||
|
(ess-tmp-exec nil)
|
|||
|
(ess-tmp-path-count (length ess-exec-path))
|
|||
|
(ess-tmp-dir nil)
|
|||
|
(ess-tmp-files nil)
|
|||
|
(ess-tmp-file nil))
|
|||
|
|
|||
|
(while ess-exec-path
|
|||
|
(setq ess-tmp-dir (car ess-exec-path)
|
|||
|
ess-exec-path (cdr ess-exec-path))
|
|||
|
(when
|
|||
|
(and (> (length ess-tmp-dir) 0)
|
|||
|
(file-accessible-directory-p ess-tmp-dir))
|
|||
|
;; the first test above excludes "" from exec-path, which can be
|
|||
|
;; problematic with Tramp.
|
|||
|
(setq ess-tmp-files
|
|||
|
(file-name-all-completions ess-root-arg ess-tmp-dir))
|
|||
|
|
|||
|
(while ess-tmp-files
|
|||
|
(setq ess-tmp-file
|
|||
|
(concat (file-name-as-directory ess-tmp-dir)
|
|||
|
(car ess-tmp-files))
|
|||
|
ess-tmp-files (cdr ess-tmp-files))
|
|||
|
(if (and (file-executable-p ess-tmp-file)
|
|||
|
(not (file-directory-p ess-tmp-file)))
|
|||
|
;; we have found a possible executable, so keep it.
|
|||
|
(setq ess-tmp-exec
|
|||
|
(nconc ess-tmp-exec (list ess-tmp-file)))))))
|
|||
|
ess-tmp-exec))
|
|||
|
|
|||
|
;; Copyright (C) 1994 Simon Marshall.
|
|||
|
;; Author: Simon Marshall <Simon.Marshall@mail.esrin.esa.it>
|
|||
|
;; LCD Archive Entry:
|
|||
|
;; unique|Simon Marshall|Simon.Marshall@mail.esrin.esa.it|
|
|||
|
;; Functions and commands to uniquify lists or buffer text (cf. sort).
|
|||
|
;; 23-Apr-1994|1.00|~/packages/unique.el.Z|
|
|||
|
;;
|
|||
|
;; MM: renamed from 'unique' to 'ess-unique', then
|
|||
|
(defun ess-uniq (list predicate)
|
|||
|
"Uniquify LIST, stably, deleting elements using PREDICATE.
|
|||
|
Return the list with subsequent duplicate items removed by side effects.
|
|||
|
PREDICATE is called with an element of LIST and a list of elements from LIST,
|
|||
|
and should return the list of elements with occurrences of the element removed.
|
|||
|
This function will work even if LIST is unsorted. See also `ess-uniq-list'."
|
|||
|
(let ((list list))
|
|||
|
(while list
|
|||
|
(setq list (setcdr list (funcall predicate (car list) (cdr list))))))
|
|||
|
list)
|
|||
|
|
|||
|
(defun ess-uniq-list (items)
|
|||
|
"Delete all duplicate entries in ITEMS list, calling `ess-uniq'."
|
|||
|
(ess-uniq items 'delete))
|
|||
|
|
|||
|
(defun ess-drop-non-directories (file-strings)
|
|||
|
"Drop all entries that do not \"look like\" directories."
|
|||
|
(ess-flatten-list (mapcar 'file-name-directory file-strings)))
|
|||
|
|
|||
|
|
|||
|
(defun ess-flatten-list (&rest list)
|
|||
|
"Take the arguments and flatten them into one long list.
|
|||
|
Drops 'nil' entries."
|
|||
|
;; Taken from lpr.el
|
|||
|
;; `lpr-flatten-list' is defined here (copied from "message.el" and
|
|||
|
;; enhanced to handle dotted pairs as well) until we can get some
|
|||
|
;; sensible autoloads, or `flatten-list' gets put somewhere decent.
|
|||
|
|
|||
|
;; (ess-flatten-list '((a . b) c (d . e) (f g h) i . j))
|
|||
|
;; => (a b c d e f g h i j)
|
|||
|
(ess-flatten-list-1 list))
|
|||
|
|
|||
|
(defun ess-flatten-list-1 (list)
|
|||
|
(cond
|
|||
|
((null list) (list))
|
|||
|
((consp list)
|
|||
|
(append (ess-flatten-list-1 (car list))
|
|||
|
(ess-flatten-list-1 (cdr list))))
|
|||
|
(t (list list))))
|
|||
|
|
|||
|
(defun ess-delete-blank-lines ()
|
|||
|
"Convert 2 or more lines of white space into one."
|
|||
|
(interactive)
|
|||
|
(save-excursion
|
|||
|
(goto-char (point-min))
|
|||
|
(save-match-data
|
|||
|
(while (search-forward-regexp "^[ \t]*\n[ \t]*\n" nil t)
|
|||
|
;;(goto-char (match-beginning 0))
|
|||
|
(delete-blank-lines)))))
|
|||
|
|
|||
|
(defun ess-do-auto-fill ()
|
|||
|
"This is the same as \\[do-auto-fill] in GNU emacs 21.3, with one major
|
|||
|
difference: if we could not find a suitable place to break the line,
|
|||
|
we simply do not break it (instead of breaking after the first word)."
|
|||
|
(let (fc justify bol give-up
|
|||
|
(fill-prefix fill-prefix))
|
|||
|
(if (or (not (setq justify (current-justification)))
|
|||
|
(null (setq fc (current-fill-column)))
|
|||
|
(and (eq justify 'left)
|
|||
|
(<= (current-column) fc))
|
|||
|
(save-excursion (beginning-of-line)
|
|||
|
(setq bol (point))
|
|||
|
(and auto-fill-inhibit-regexp
|
|||
|
(looking-at auto-fill-inhibit-regexp))))
|
|||
|
nil ;; Auto-filling not required
|
|||
|
(if (memq justify '(full center right))
|
|||
|
(save-excursion (unjustify-current-line)))
|
|||
|
|
|||
|
;; Choose a fill-prefix automatically.
|
|||
|
(if (and adaptive-fill-mode
|
|||
|
(or (null fill-prefix) (string= fill-prefix "")))
|
|||
|
(let ((prefix
|
|||
|
(fill-context-prefix
|
|||
|
(save-excursion (backward-paragraph 1) (point))
|
|||
|
(save-excursion (forward-paragraph 1) (point)))))
|
|||
|
(and prefix (not (equal prefix ""))
|
|||
|
(setq fill-prefix prefix))))
|
|||
|
|
|||
|
(while (and (not give-up) (> (current-column) fc))
|
|||
|
;; Determine where to split the line.
|
|||
|
(let* (after-prefix
|
|||
|
(fill-point
|
|||
|
(let ((opoint (point))
|
|||
|
bounce
|
|||
|
(first t))
|
|||
|
(save-excursion
|
|||
|
(beginning-of-line)
|
|||
|
(setq after-prefix (point))
|
|||
|
(and fill-prefix
|
|||
|
(looking-at (regexp-quote fill-prefix))
|
|||
|
(setq after-prefix (match-end 0)))
|
|||
|
(move-to-column (1+ fc))
|
|||
|
;; Move back to the point where we can break the line.
|
|||
|
;; We break the line between word or
|
|||
|
;; after/before the character which has character
|
|||
|
;; category `|'. We search space, \c| followed by
|
|||
|
;; a character, or \c| following a character. If
|
|||
|
;; not found, place the point at beginning of line.
|
|||
|
(while (or first
|
|||
|
;; If this is after period and a single space,
|
|||
|
;; move back once more--we don't want to break
|
|||
|
;; the line there and make it look like a
|
|||
|
;; sentence end.
|
|||
|
(and (not (bobp))
|
|||
|
(not bounce)
|
|||
|
sentence-end-double-space
|
|||
|
(save-excursion (forward-char -1)
|
|||
|
(and (looking-at "\\. ")
|
|||
|
(not (looking-at "\\. ")))))
|
|||
|
(and (not (bobp))
|
|||
|
(not bounce)
|
|||
|
fill-nobreak-predicate
|
|||
|
(funcall fill-nobreak-predicate)))
|
|||
|
(setq first nil)
|
|||
|
(re-search-backward "[ \t]\\|\\c|.\\|.\\c|\\|^")
|
|||
|
;; If we find nowhere on the line to break it,
|
|||
|
;; do not break it. Set bounce to t
|
|||
|
;; so we will not keep going in this while loop.
|
|||
|
(if (<= (point) after-prefix)
|
|||
|
(setq bounce t)
|
|||
|
(if (looking-at "[ \t]")
|
|||
|
;; Break the line at word boundary.
|
|||
|
(skip-chars-backward " \t")
|
|||
|
;; Break the line after/before \c|.
|
|||
|
(forward-char 1))))
|
|||
|
(if enable-multibyte-characters
|
|||
|
;; If we are going to break the line after or
|
|||
|
;; before a non-ascii character, we may have
|
|||
|
;; to run a special function for the charset
|
|||
|
;; of the character to find the correct break
|
|||
|
;; point.
|
|||
|
(if (not (and (eq (charset-after (1- (point))) 'ascii)
|
|||
|
(eq (charset-after (point)) 'ascii)))
|
|||
|
(fill-find-break-point after-prefix)))
|
|||
|
|
|||
|
;; Let fill-point be set to the place where we end up.
|
|||
|
;; But move back before any whitespace here.
|
|||
|
(skip-chars-backward " \t")
|
|||
|
(point)))))
|
|||
|
|
|||
|
;; See whether the place we found is any good.
|
|||
|
(if (save-excursion
|
|||
|
(goto-char fill-point)
|
|||
|
(and (not (bolp))
|
|||
|
;; There is no use breaking at end of line.
|
|||
|
(not (save-excursion (skip-chars-forward " ") (eolp)))
|
|||
|
;; It is futile to split at the end of the prefix
|
|||
|
;; since we would just insert the prefix again.
|
|||
|
(not (and after-prefix (<= (point) after-prefix)))
|
|||
|
;; Don't split right after a comment starter
|
|||
|
;; since we would just make another comment starter.
|
|||
|
(not (and comment-start-skip
|
|||
|
(let ((limit (point)))
|
|||
|
(beginning-of-line)
|
|||
|
(and (re-search-forward comment-start-skip
|
|||
|
limit t)
|
|||
|
(eq (point) limit)))))))
|
|||
|
;; Ok, we have a useful place to break the line. Do it.
|
|||
|
(let ((prev-column (current-column)))
|
|||
|
;; If point is at the fill-point, do not `save-excursion'.
|
|||
|
;; Otherwise, if a comment prefix or fill-prefix is inserted,
|
|||
|
;; point will end up before it rather than after it.
|
|||
|
(if (save-excursion
|
|||
|
(skip-chars-backward " \t")
|
|||
|
(= (point) fill-point))
|
|||
|
(funcall comment-line-break-function t)
|
|||
|
(save-excursion
|
|||
|
(goto-char fill-point)
|
|||
|
(funcall comment-line-break-function t)))
|
|||
|
;; Now do justification, if required
|
|||
|
(if (not (eq justify 'left))
|
|||
|
(save-excursion
|
|||
|
(end-of-line 0)
|
|||
|
(justify-current-line justify nil t)))
|
|||
|
;; If making the new line didn't reduce the hpos of
|
|||
|
;; the end of the line, then give up now;
|
|||
|
;; trying again will not help.
|
|||
|
(if (>= (current-column) prev-column)
|
|||
|
(setq give-up t)))
|
|||
|
;; No good place to break => stop trying.
|
|||
|
(setq give-up t))))
|
|||
|
;; Justify last line.
|
|||
|
(justify-current-line justify t t)
|
|||
|
t)))
|
|||
|
|
|||
|
(defun ess-select-frame-set-input-focus (frame)
|
|||
|
"Select FRAME, raise it, and set input focus, if possible.
|
|||
|
Copied almost verbatim from gnus-utils.el (but with test for mac added)."
|
|||
|
(cond ((featurep 'xemacs)
|
|||
|
(raise-frame frame)
|
|||
|
(select-frame frame)
|
|||
|
(focus-frame frame))
|
|||
|
;; The function `select-frame-set-input-focus' won't set
|
|||
|
;; the input focus under Emacs 21.2 and X window system.
|
|||
|
;;((fboundp 'select-frame-set-input-focus)
|
|||
|
;; (defalias 'gnus-select-frame-set-input-focus
|
|||
|
;; 'select-frame-set-input-focus)
|
|||
|
;; (select-frame-set-input-focus frame))
|
|||
|
(t
|
|||
|
(raise-frame frame)
|
|||
|
(select-frame frame)
|
|||
|
(cond ((and
|
|||
|
(memq window-system '(x mac))
|
|||
|
(fboundp 'x-focus-frame))
|
|||
|
(x-focus-frame frame))
|
|||
|
((eq window-system 'w32)
|
|||
|
(w32-focus-frame frame)))
|
|||
|
(when focus-follows-mouse
|
|||
|
(set-mouse-position frame (1- (frame-width frame)) 0)))))
|
|||
|
|
|||
|
(defun ess-sci-to-dec ()
|
|||
|
"For BUGS/S family: Express +/-0.000E+/-0 or +/-0.0e+/-00 as a decimal."
|
|||
|
(interactive)
|
|||
|
(setq buffer-read-only nil)
|
|||
|
(save-excursion (goto-char 0)
|
|||
|
(save-match-data (let ((ess-temp-replacement-string nil)
|
|||
|
(ess-temp-replacement-9 0)
|
|||
|
(ess-temp-replacement-diff 0))
|
|||
|
(while (search-forward-regexp "-?[0-9][.][0-9][0-9]?[0-9]?[Ee][+-][0-9][0-9]?" nil t)
|
|||
|
(setq ess-temp-replacement-string
|
|||
|
(int-to-string (string-to-number (match-string 0))))
|
|||
|
(setq ess-temp-replacement-diff (- (match-end 0) (match-beginning 0)))
|
|||
|
(save-match-data
|
|||
|
(setq ess-temp-replacement-9
|
|||
|
(string-match "99999999999$" ess-temp-replacement-string))
|
|||
|
|
|||
|
(if (not ess-temp-replacement-9)
|
|||
|
(setq ess-temp-replacement-9
|
|||
|
(string-match "000000000001$" ess-temp-replacement-string))))
|
|||
|
|
|||
|
(if ess-temp-replacement-9
|
|||
|
(setq ess-temp-replacement-string
|
|||
|
(substring ess-temp-replacement-string 0 ess-temp-replacement-9)))
|
|||
|
|
|||
|
(setq ess-temp-replacement-diff
|
|||
|
(- ess-temp-replacement-diff (string-width ess-temp-replacement-string)))
|
|||
|
|
|||
|
(while (> ess-temp-replacement-diff 0)
|
|||
|
(setq ess-temp-replacement-string (concat ess-temp-replacement-string " "))
|
|||
|
(setq ess-temp-replacement-diff (- ess-temp-replacement-diff 1)))
|
|||
|
|
|||
|
(replace-match ess-temp-replacement-string))))))
|
|||
|
|
|||
|
(defun ess-num-or-zero (arg)
|
|||
|
"*If a number, then return that number, otherwise return 0."
|
|||
|
(or (and (numberp arg) arg) 0))
|
|||
|
|
|||
|
|
|||
|
; Timer management
|
|||
|
|
|||
|
(defcustom ess-idle-timer-interval 1
|
|||
|
"Number of idle seconds to wait before running function in
|
|||
|
`ess-idle-timer-functions'."
|
|||
|
:group 'ess)
|
|||
|
|
|||
|
(defvar ess-idle-timer-functions nil
|
|||
|
"A list of functions to run each `ess-idle-timer-interval' idle seconds.
|
|||
|
|
|||
|
If your function calls the process, you better use
|
|||
|
`ess-when-new-input' to wrap your call. If you call the
|
|||
|
subprocess please respect `ess-can-eval-in-background' variable.
|
|||
|
|
|||
|
These functions are run with `run-hooks'. Use `add-hook' to add
|
|||
|
symbols to this variable.
|
|||
|
|
|||
|
Most likely you will need a local hook. Then you should specify
|
|||
|
the LOCAL argument to `add-hook' and initialise it in
|
|||
|
`ess-mode-hook' or `ess-post-run-hook', or one of the more
|
|||
|
specialised hooks `ess-R-post-run-hook',`ess-stata-post-run-hook'
|
|||
|
etc.
|
|||
|
")
|
|||
|
|
|||
|
(defun ess--idle-timer-function nil
|
|||
|
"Internal function executed by `ess--idle-timer'"
|
|||
|
;; (while-no-input
|
|||
|
(run-hooks 'ess-idle-timer-functions))
|
|||
|
|
|||
|
(require 'timer)
|
|||
|
(defvar ess--idle-timer
|
|||
|
(run-with-idle-timer ess-idle-timer-interval 'repeat 'ess--idle-timer-function)
|
|||
|
"Timer used to run `ess-idle-timer-functions'.")
|
|||
|
|
|||
|
(defmacro ess-when-new-input (time-var &rest body)
|
|||
|
"BODY is evaluate only if the value of procss variable TIME-VAR
|
|||
|
is bigger than the time of the last user input (stored in
|
|||
|
'last-eval' process variable). TIME-VAR is the name of the
|
|||
|
process variable which holds the access time. See the code for
|
|||
|
`ess-synchronize-dirs' and `ess-cache-search-list'.
|
|||
|
|
|||
|
Returns nil when no current process, or process is busy, or
|
|||
|
time-var > last-eval. Otherwise, execute BODY and return the last
|
|||
|
value.
|
|||
|
|
|||
|
If BODY is executed, set process variable TIME-VAR
|
|||
|
to (current-time).
|
|||
|
|
|||
|
Variable *proc* is bound to the current process during the
|
|||
|
evaluation of BODY.
|
|||
|
|
|||
|
Should be used in `ess-idle-timer-functions' which call the
|
|||
|
process to avoid excessive requests.
|
|||
|
"
|
|||
|
(declare (indent 1) (debug t))
|
|||
|
`(with-ess-process-buffer 'no-error
|
|||
|
(let ((le (process-get *proc* 'last-eval))
|
|||
|
(tv (process-get *proc* ',time-var)))
|
|||
|
(when (and (or (null tv) (null le) (time-less-p tv le))
|
|||
|
(not (process-get *proc* 'busy)))
|
|||
|
(let ((out (progn ,@body)))
|
|||
|
(process-put *proc* ',time-var (current-time))
|
|||
|
out)))))
|
|||
|
|
|||
|
|
|||
|
(defmacro ess--execute-electric-command (map &optional prompt wait exit-form &rest args)
|
|||
|
"Execute single-key comands defined in MAP till a key is pressed which is not part of map.
|
|||
|
|
|||
|
Return the value of the lastly executed command.
|
|||
|
|
|||
|
Single-key input commands are those that once executed do not
|
|||
|
requre the prefix command for subsequent invocation.
|
|||
|
|
|||
|
PROMPT is passed to `read-event'.
|
|||
|
|
|||
|
If WAIT is t, wait for next input and ignore the keystroke which
|
|||
|
triggered the command.
|
|||
|
|
|||
|
Each command in map should accept one at least one argument, the
|
|||
|
most recent event (as read by `read-event'). ARGS are the
|
|||
|
supplementary arguments passed to the commands.
|
|||
|
|
|||
|
EXIT-FORM should be supplied for a more refined control of the
|
|||
|
read-even loop. The loop is exited when EXIT-FORM evaluates to
|
|||
|
t. See examples in the tracebug code.
|
|||
|
"
|
|||
|
;;VS[09-06-2013]: check: it seems that set-temporary-overlay-map is designed
|
|||
|
;;for this type of things; see also repeat.el package.
|
|||
|
`(let* ((ev last-command-event)
|
|||
|
(command (lookup-key ,map (vector ev)))
|
|||
|
out exit )
|
|||
|
(if (not (or ,wait command))
|
|||
|
(message "%s is undefined" (key-description (this-command-keys)))
|
|||
|
(unless ,wait
|
|||
|
(setq out (and command (funcall command ev ,@args))))
|
|||
|
(while (and (not exit)
|
|||
|
(setq command
|
|||
|
(lookup-key ,map
|
|||
|
(vector (setq ev (read-event ,prompt))))))
|
|||
|
(setq out (funcall command ev ,@args))
|
|||
|
(sleep-for .01)
|
|||
|
(setq exit ,exit-form))
|
|||
|
(unless exit ;; push only if an event triggered the exit
|
|||
|
(push ev unread-command-events))
|
|||
|
out)))
|
|||
|
|
|||
|
(defmacro ess-execute-dialect-specific (command &optional prompt &rest args)
|
|||
|
"Execute dialect specific command.
|
|||
|
|
|||
|
-- If command is nil issue warning 'Not available for dialect X'
|
|||
|
-- If command is a elisp function, execute it with ARGS
|
|||
|
-- If a string starting with 'http' or 'www', browse with `browse-url',
|
|||
|
otherwise execute the command in inferior process.
|
|||
|
-- If a string, interpret as a command to subprocess, and
|
|||
|
substitute ARGS with `(format ,command ,@args).
|
|||
|
|
|||
|
When PROMPT is non-nil ask the user for a string value and
|
|||
|
prepend the response to ARGS.
|
|||
|
|
|||
|
If prompt is a string just pass it to `read-string'. If a list, pass it
|
|||
|
to `ess-completing-read'.
|
|||
|
"
|
|||
|
`(if (null ,command)
|
|||
|
(message "Not implemented for dialect %s" ess-dialect)
|
|||
|
(let* ((com (if (symbolp ,command)
|
|||
|
(symbol-function ,command)
|
|||
|
,command))
|
|||
|
(prompt ',prompt)
|
|||
|
(resp (and prompt
|
|||
|
(if (stringp prompt)
|
|||
|
(read-string prompt)
|
|||
|
(apply 'ess-completing-read prompt))))
|
|||
|
(args (append (list resp) ',args)))
|
|||
|
(cond ((functionp com)
|
|||
|
(apply com args))
|
|||
|
((and (stringp com)
|
|||
|
(string-match "^\\(http\\|www\\)" com))
|
|||
|
(setq com (apply 'format com args))
|
|||
|
(require 'browse-url)
|
|||
|
(browse-url com))
|
|||
|
((stringp com)
|
|||
|
(unless (string-match "\n$" com)
|
|||
|
(setq com (concat com "\n")))
|
|||
|
(setq com (apply 'format com args))
|
|||
|
(ess-eval-linewise com))
|
|||
|
(t
|
|||
|
(error "Argument COMMAND must be either a function or a string"))))))
|
|||
|
|
|||
|
|
|||
|
|
|||
|
;; SJE: 2009-01-30 -- this contribution from
|
|||
|
;; Erik Iverson <iverson@biostat.wisc.edu>
|
|||
|
|
|||
|
(defun ess-tooltip-show-at-point (text xo yo)
|
|||
|
"Show a tooltip displaying 'text' at (around) point, xo and yo are x-
|
|||
|
and y-offsets for the toolbar from point."
|
|||
|
(let (
|
|||
|
(fx (frame-parameter nil 'left))
|
|||
|
(fy (frame-parameter nil 'top))
|
|||
|
(fw (frame-pixel-width))
|
|||
|
(fh (frame-pixel-height))
|
|||
|
frame-left frame-top my-x-offset my-y-offset)
|
|||
|
|
|||
|
;; The following comment was found before code looking much like that
|
|||
|
;; of frame-left and frame-top below in the file
|
|||
|
;; tooltip-help.el. I include it here for acknowledgement, and I did observe
|
|||
|
;; the same behavior with the Emacs window maximized under Windows XP.
|
|||
|
|
|||
|
;; -----original comment--------
|
|||
|
;; handles the case where (frame-parameter nil 'top) or
|
|||
|
;; (frame-parameter nil 'left) return something like (+ -4).
|
|||
|
;; This was the case where e.g. Emacs window is maximized, at
|
|||
|
;; least on Windows XP. The handling code is "shamelessly
|
|||
|
;; stolen" from cedet/speedbar/dframe.el
|
|||
|
;; (contributed by Andrey Grigoriev)
|
|||
|
|
|||
|
(setq frame-left (if (not (consp fx))
|
|||
|
fx
|
|||
|
(if (eq (car fx) '-)
|
|||
|
(- (x-display-pixel-width) (car (cdr fx)) fw)
|
|||
|
(car (cdr fx)))))
|
|||
|
|
|||
|
(setq frame-top (if (not (consp fy))
|
|||
|
fy
|
|||
|
(if (eq (car fy) '-)
|
|||
|
(- (x-display-pixel-height) (car (cdr fy)) fh)
|
|||
|
(car (cdr fy)))))
|
|||
|
|
|||
|
;; calculate the offset from point, use xo and yo to adjust to preference
|
|||
|
(setq my-x-offset (+ (car(window-inside-pixel-edges))
|
|||
|
(car(posn-x-y (posn-at-point)))
|
|||
|
frame-left xo))
|
|||
|
|
|||
|
(setq my-y-offset (+ (cadr(window-inside-pixel-edges))
|
|||
|
(cdr(posn-x-y (posn-at-point)))
|
|||
|
frame-top yo))
|
|||
|
|
|||
|
(let ((tooltip-frame-parameters
|
|||
|
(cons (cons 'top my-y-offset)
|
|||
|
(cons (cons 'left my-x-offset)
|
|||
|
tooltip-frame-parameters))))
|
|||
|
(tooltip-show text))
|
|||
|
))
|
|||
|
|
|||
|
|
|||
|
;; (defun ess-tooltip-show-at-point (text xo yo)
|
|||
|
;; (with-no-warnings
|
|||
|
;; (pos-tip-show text
|
|||
|
;; 'popup-tip-face
|
|||
|
;; (point)
|
|||
|
;; nil tooltip-hide-delay
|
|||
|
;; popup-tip-max-width
|
|||
|
;; nil xo yo)))
|
|||
|
|
|||
|
|
|||
|
(defvar ess-build-tags-command nil
|
|||
|
"Command passed to generate tags.
|
|||
|
|
|||
|
If nil, `ess-build-tags-for-directory' uses the mode's imenu
|
|||
|
regexpresion. Othersiwe, it should be a string with two %s
|
|||
|
formats: one for directory and another for the output file.")
|
|||
|
|
|||
|
|
|||
|
(defun ess-build-tags-for-directory (dir tagfile)
|
|||
|
"Ask for directory and tag file and build tags for current dialect.
|
|||
|
|
|||
|
If the current language defines `ess-build-tags-command' use it
|
|||
|
and ask the subprocess to build the tags. Otherwise use imenu
|
|||
|
regexp and call find .. | etags .. in a shell command. You must
|
|||
|
have 'find' and 'etags' programs installed.
|
|||
|
|
|||
|
Use M-. to navigate to a tag. M-x `visit-tags-table' to
|
|||
|
append/replace the currently used tag table.
|
|||
|
|
|||
|
If prefix is given, force tag generation based on imenu. Might be
|
|||
|
useful when different language files are also present in the
|
|||
|
directory (.cpp, .c etc)."
|
|||
|
(interactive "DDirectory to tag:
|
|||
|
GTags file (default TAGS): ")
|
|||
|
(when (or (eq (length (file-name-nondirectory tagfile)) 0)
|
|||
|
(file-directory-p tagfile))
|
|||
|
(setq tagfile (concat (file-name-as-directory tagfile) "TAGS")))
|
|||
|
;; emacs find-tags doesn't play well with remote TAG files :(
|
|||
|
(when (file-remote-p tagfile)
|
|||
|
(require 'tramp)
|
|||
|
(setq tagfile (with-parsed-tramp-file-name tagfile foo foo-localname)))
|
|||
|
(when (file-remote-p dir)
|
|||
|
(setq dir (with-parsed-tramp-file-name dir foo foo-localname)))
|
|||
|
(if (and ess-build-tags-command (null current-prefix-arg))
|
|||
|
(ess-eval-linewise (format ess-build-tags-command dir tagfile))
|
|||
|
;; else generate from imenu
|
|||
|
(unless (or imenu-generic-expression ess-imenu-generic-expression) ;; need both!!
|
|||
|
(error "No ess-tag-command found, and no imenu-generic-expression defined"))
|
|||
|
(let* ((find-cmd
|
|||
|
(format "find %s -type f -size 1M \\( -regex \".*\\.\\(cpp\\|jl\\|[RsrSch]\\(nw\\)?\\)$\" \\)" dir))
|
|||
|
(regs (delq nil (mapcar (lambda (l)
|
|||
|
(if (string-match "'" (cadr l))
|
|||
|
nil ;; remove for time being
|
|||
|
(format "/%s/\\%d/"
|
|||
|
(replace-regexp-in-string "/" "\\/" (nth 1 l) t)
|
|||
|
(nth 2 l))))
|
|||
|
imenu-generic-expression)))
|
|||
|
(tags-cmd (format "etags -o %s --regex='%s' -" tagfile
|
|||
|
(mapconcat 'identity regs "' --regex='"))))
|
|||
|
(message "Building tags: %s" tagfile)
|
|||
|
;; (dbg (format "%s | %s" find-cmd tags-cmd))
|
|||
|
(when (= 0 (shell-command (format "%s | %s" find-cmd tags-cmd)))
|
|||
|
(message "Building tags .. ok!")))))
|
|||
|
|
|||
|
|
|||
|
(defun ess-function-arguments (funname &optional proc)
|
|||
|
"Get FUNARGS from cache or ask the process for it.
|
|||
|
|
|||
|
Return FUNARGS - a list with the first element being a
|
|||
|
cons (package_name . time_stamp_of_request), second element is a
|
|||
|
string giving arguments of the function as they appear in
|
|||
|
documentation, third element is a list of arguments of all
|
|||
|
methods.
|
|||
|
|
|||
|
If package_name is nil, and time_stamp is less recent than the
|
|||
|
time of the last user interaction to the process, then update the
|
|||
|
entry.
|
|||
|
|
|||
|
Package_name is also nil when funname was not found, or funname
|
|||
|
is a special name that contains :,$ or @.
|
|||
|
|
|||
|
If PROC is given, it should be an ESS process which should be
|
|||
|
queried for arguments.
|
|||
|
"
|
|||
|
|
|||
|
(when (and funname ;; usually returned by ess--funname.start (might be nil)
|
|||
|
(or proc (ess-process-live-p)))
|
|||
|
(let* ((proc (or proc (get-process ess-local-process-name)))
|
|||
|
(args (gethash funname (process-get proc 'funargs-cache)))
|
|||
|
(pack (caar args))
|
|||
|
(ts (cdar args)))
|
|||
|
(when (and args
|
|||
|
(and (time-less-p ts (process-get proc 'last-eval))
|
|||
|
(or (null pack)
|
|||
|
(equal pack ""))))
|
|||
|
;; reset cache
|
|||
|
(setq args nil))
|
|||
|
(or args
|
|||
|
(cadr (assoc funname (process-get proc 'funargs-pre-cache)))
|
|||
|
(and
|
|||
|
(not (process-get proc 'busy))
|
|||
|
(with-current-buffer (ess-command (format ess-funargs-command
|
|||
|
(ess-quote-special-chars funname))
|
|||
|
nil nil nil nil proc)
|
|||
|
(goto-char (point-min))
|
|||
|
(when (re-search-forward "(list" nil t)
|
|||
|
(goto-char (match-beginning 0))
|
|||
|
(setq args (ignore-errors (eval (read (current-buffer)))))
|
|||
|
(if args
|
|||
|
(setcar args (cons (car args) (current-time)))))
|
|||
|
;; push even if nil
|
|||
|
(puthash (substring-no-properties funname) args (process-get proc 'funargs-cache))))))))
|
|||
|
|
|||
|
(defun ess-symbol-start ()
|
|||
|
"Get initial position for objects completion."
|
|||
|
(let ((beg (car (bounds-of-thing-at-point 'symbol))))
|
|||
|
(when (and beg (not (save-excursion (goto-char beg)
|
|||
|
(looking-at "/\\|.[0-9]"))))
|
|||
|
beg)))
|
|||
|
|
|||
|
(defun ess-arg-start ()
|
|||
|
"Get initial position for args completion"
|
|||
|
(when (not (ess-inside-string-p))
|
|||
|
(when (ess--funname.start)
|
|||
|
(if (looking-back "[(,]+[ \t\n]*")
|
|||
|
(point)
|
|||
|
(ess-symbol-start)))))
|
|||
|
|
|||
|
(defvar ess--funname.start nil)
|
|||
|
|
|||
|
(defun ess--funname.start (&optional look-back)
|
|||
|
"If inside a function call, return (FUNNAMME . START) where
|
|||
|
FUNNAME is a function name found before ( and START is where
|
|||
|
FUNNAME starts.
|
|||
|
|
|||
|
LOOK-BACK is a number of characters to look back; defaults to
|
|||
|
2000. As the search might get quite slow for files with thousands
|
|||
|
of lines.
|
|||
|
|
|||
|
Also store the cons in 'ess--funname.start for potential use
|
|||
|
later."
|
|||
|
(save-excursion
|
|||
|
(save-restriction
|
|||
|
(let* ((proc (get-buffer-process (current-buffer)))
|
|||
|
(mark (and proc (process-mark proc))))
|
|||
|
|
|||
|
(if (and mark (>= (point) mark))
|
|||
|
(narrow-to-region mark (point)))
|
|||
|
|
|||
|
(and ess-noweb-mode
|
|||
|
(ess-noweb-narrow-to-chunk))
|
|||
|
|
|||
|
(unless (ess-inside-string-p)
|
|||
|
(setq ess--funname.start
|
|||
|
(condition-case nil ;; check if it is inside a functon
|
|||
|
(progn
|
|||
|
;; for the sake of big buffers, look only 1000 chars back
|
|||
|
(narrow-to-region (max (point-min) (- (point) 1000)) (point))
|
|||
|
(up-list -1)
|
|||
|
(while (not (looking-at "("))
|
|||
|
(up-list -1))
|
|||
|
(let ((funname (symbol-name (symbol-at-point))))
|
|||
|
(when (and funname
|
|||
|
(not (member funname ess-S-non-functions)))
|
|||
|
(cons funname (- (point) (length funname))))
|
|||
|
))
|
|||
|
(error nil))
|
|||
|
))))))
|
|||
|
|
|||
|
(defun ess--inject-code-from-file (file)
|
|||
|
;; this is different from ess-load-file
|
|||
|
(let ((content (with-temp-buffer
|
|||
|
(insert-file-contents file)
|
|||
|
(buffer-string))))
|
|||
|
(when (string= ess-dialect "R")
|
|||
|
;; don't detect intermediate prompts
|
|||
|
(setq content (concat "{" content "}\n")))
|
|||
|
(ess-command content)))
|
|||
|
|
|||
|
(provide 'ess-utils)
|
|||
|
|
|||
|
;;; ess-utils.el ends here
|