add lisp packages
This commit is contained in:
173
lisp/ess/obsolete/ess-eldoc.el
Normal file
173
lisp/ess/obsolete/ess-eldoc.el
Normal file
@@ -0,0 +1,173 @@
|
||||
;;; ess-eldoc.el --- Use eldoc to report R function names.
|
||||
|
||||
;; Copyright (C) 1997-2020 Free Software Foundation, Inc.
|
||||
;; Author: Stephen Eglen
|
||||
;; Created: 2007-06-30
|
||||
;; Maintainer: ESS-core <ESS-core@r-project.org>
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;;; License:
|
||||
;;
|
||||
;; This program 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 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
;;
|
||||
;; This program 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.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see
|
||||
;; <http://www.gnu.org/licenses/>
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;;;; eldoc funcitonality has been moved into the core ;;;;;
|
||||
;;;;; this file has no effect and is left in ESS in order not to break
|
||||
;;;;; users configuration
|
||||
|
||||
;; This is an initial attempt to use the emacs facility ELDOC in R
|
||||
;; buffers. Eldoc is used in Emacs lisp buffers to show the function
|
||||
;; arglist and docstrings for variables. To try it, view an emacs
|
||||
;; lisp buffer, and then do M-x turn-on-eldoc-mode, and move over
|
||||
;; function and variable names.
|
||||
|
||||
;; This file extends eldoc to work in R buffers. It currently uses
|
||||
;; Sven's ess-r-args.el file to retrieve args for a given R function
|
||||
;; (via ess-r-args-get). Note that it works slightly different to
|
||||
;; Sven's code, in that you just need to have the point over the name
|
||||
;; of an R function, or inside its arguments list, for eldoc to show
|
||||
;; the arg list.
|
||||
|
||||
;; To use this functionality, simply add
|
||||
;;
|
||||
;; (require 'ess-eldoc)
|
||||
;;
|
||||
;; to your .emacs file. When you visit a R mode, eldoc will be turned
|
||||
;; on. However, you will first need to associate the R buffer with an
|
||||
;; *R* process so that args can be looked up -- otherwise, eldoc will
|
||||
;; silently not report anything. So, e.g. try:
|
||||
;; C-x C-f somefile.R
|
||||
;; M-x R (so that somefile.R is associated with *R*)
|
||||
;; eldoc should then work.
|
||||
|
||||
;; e.g. put the following rnorm() command in an R buffer. The line
|
||||
;; underneath shows a key of what arg list will be shown as you move
|
||||
;; across the rnorm line.
|
||||
|
||||
;; rnorm(n=100, mean=sqrt(20), sd=10)
|
||||
;; 1111111111111222223333333311444111
|
||||
;; 1: rnorm
|
||||
;; 2: mean
|
||||
;; 3: sqrt
|
||||
;; 4: sd
|
||||
;;
|
||||
|
||||
;; Note that the arg list for rnorm() should be shown either when you
|
||||
;; are on the function name, or in the arg list. However, since the
|
||||
;; 2nd and 3rd arguments are also function names, the arg lists of
|
||||
;; those function names are reported instead. This might be seen as
|
||||
;; undesirable behaviour, in which case a solution would be to only
|
||||
;; look up the function name if it is followed by (.
|
||||
|
||||
;; If you want to use this feature in *R* buffers, add the following
|
||||
;; to .emacs:
|
||||
;; (add-hook 'inferior-ess-mode-hook 'ess-use-eldoc)
|
||||
|
||||
|
||||
;; In the current version, I do not cache the arg list, but that was
|
||||
;; done in an earlier version, to save repeated calls to
|
||||
;; ess-r-args-get.
|
||||
|
||||
;; This code has been tested only in Emacs 22.1. It will not work on
|
||||
;; Emacs 21, because it needs the variable
|
||||
;; eldoc-documentation-function.
|
||||
|
||||
;;;; VS [25-02-2012]: all these issues were at least partially addresed in the
|
||||
;;;; new implementation:
|
||||
|
||||
;; Bug (in eldoc?): the arg list for legend() is too long to fit in
|
||||
;; minibuffer, and it seems that we see the last N lines of the arg
|
||||
;; list, rather than the first N lines. It would be better to see the
|
||||
;; first N lines since the more important args come first.
|
||||
|
||||
;; Doc issue: the eldoc vars (e.g. eldoc-echo-area-use-multiline-p)
|
||||
;; work only for elisp mode.
|
||||
|
||||
;; Issue: You will probably see the message "Using process 'R'" flash;
|
||||
;; this is generated by `ess-request-a-process', and I'd like to avoid
|
||||
;; that appearing, non-interactively.
|
||||
|
||||
;; If *R* is currently busy (e.g. processing Sys.sleep(999)), then the
|
||||
;; eldoc commands won't work; ess-command could be silenced in this
|
||||
;; regard perhaps with a new SILENT arg for example to prevent the
|
||||
;; call to (ess-error).
|
||||
|
||||
|
||||
;;; Code:
|
||||
|
||||
;; ;; This could be done on buffer local basis.
|
||||
;; (setq ess-r-args-noargsmsg "")
|
||||
|
||||
;; ;; following two defvars are not currently used.
|
||||
;; (defvar ess-eldoc-last-name nil
|
||||
;; "Name of the last function looked up in eldoc.
|
||||
;; We remember this to see whether we need to look up documentation, or used
|
||||
;; the cached value in `ess-eldoc-last-args'.")
|
||||
|
||||
;; (defvar ess-eldoc-last-args nil
|
||||
;; "Args list last looked up for eldoc. Used as cache.")
|
||||
|
||||
;; (defun ess-eldoc-2 ()
|
||||
;; ;; simple, old version.
|
||||
;; (interactive)
|
||||
;; (ess-r-args-get (ess-read-object-name-default)))
|
||||
|
||||
;; (defun ess-eldoc-1 ()
|
||||
;; "Return the doc string, or nil.
|
||||
;; This is the first version; works only on function name, not within arg list."
|
||||
;; (interactive)
|
||||
|
||||
;; ;; Possible ways to get the function at point.
|
||||
;; ;;(setq name (thing-at-point 'sexp))
|
||||
;; ;;(setq name (ess-read-object-name-default))
|
||||
;; ;;(setq name (find-tag-default))
|
||||
|
||||
;; (if ess-current-process-name
|
||||
;; (progn
|
||||
;; (setq name (ess-guess-fun)) ;guess the word at point.
|
||||
;; (if (equal (length name) 0)
|
||||
;; nil
|
||||
;; ;; else
|
||||
;; (unless (equal name ess-eldoc-last-name)
|
||||
;; ;; name is different to the last name we lookedup, so get
|
||||
;; ;; new args from R and store them.
|
||||
;; (setq ess-eldoc-last-args (ess-r-args-get name)
|
||||
;; ess-eldoc-last-name name))
|
||||
;; ess-eldoc-last-args))
|
||||
;; ;; no ESS process current.
|
||||
;; nil)
|
||||
;; )
|
||||
|
||||
|
||||
;; (defsubst ess-guess-fun ()
|
||||
;; "Guess what the function at point is."
|
||||
;; ;; Derived from Man-default-man-entry in man.el
|
||||
;; (let (word)
|
||||
;; (save-excursion
|
||||
;; (skip-chars-backward "-a-zA-Z0-9._+:")
|
||||
;; (let ((start (point)))
|
||||
;; (skip-chars-forward "-a-zA-Z0-9._+:")
|
||||
;; (setq word (buffer-substring-no-properties start (point)))))
|
||||
;; word))
|
||||
|
||||
(defun ess-use-eldoc ()
|
||||
"Does nothing. Defined not to break old users' code."
|
||||
(interactive))
|
||||
|
||||
(provide 'ess-eldoc)
|
||||
|
||||
;;; ess-eldoc.el ends here
|
||||
222
lisp/ess/obsolete/ess-mouse.el
Normal file
222
lisp/ess/obsolete/ess-mouse.el
Normal file
@@ -0,0 +1,222 @@
|
||||
;;; ess-mouse.el --- Support for mouse- or cursor-sensitive actions
|
||||
|
||||
;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
|
||||
;; Author: Richard M. Heiberger <rmh@temple.edu>
|
||||
;; Created: 25 Mar 2001
|
||||
;; Maintainer: ESS-core <ESS-core@r-project.org>
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;;; License:
|
||||
;;
|
||||
;; This program 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 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
;;
|
||||
;; This program 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.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see
|
||||
;; <http://www.gnu.org/licenses/>
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Support for mouse- or cursor-sensitive actions. This is based on
|
||||
;; and uses mouseme.el. mouseme.el only does mouse sensititivity.
|
||||
;; The new functions ess-mouse-me and ess-mouse-me-helper do similar
|
||||
;; things based on the cursor, not the mouse, and can be bound to a
|
||||
;; keystroke.
|
||||
|
||||
;;; Code:
|
||||
|
||||
; Requires and autoloads
|
||||
|
||||
;;*;; Requires
|
||||
(require 'mouseme)
|
||||
(require 'ess-trns)
|
||||
;;(if (or (equal window-system 'w32)
|
||||
;; (equal window-system 'win32)
|
||||
;; (equal window-system 'mswindows))
|
||||
;; (require 'essiw32b))
|
||||
|
||||
(defun ess-mouse-me ()
|
||||
"Popup a menu of functions to run on selected string or region."
|
||||
(interactive)
|
||||
(ess-mouse-me-helper
|
||||
(lambda (name)
|
||||
(or (x-popup-menu (list '(0 0)
|
||||
(get-buffer-window (get-buffer (buffer-name))))
|
||||
(funcall mouse-me-build-menu-function name))
|
||||
(error "No command to run")))))
|
||||
|
||||
|
||||
|
||||
(defun ess-mouse-me-helper (func)
|
||||
"Determine the string to use to process EVENT and call FUNC to get cmd."
|
||||
(let (name sp sm mouse beg end cmd mmtype)
|
||||
;; temporarily goto where the event occurred, get the name clicked
|
||||
;; on and enough info to figure out what to do with it
|
||||
(save-match-data
|
||||
(save-excursion
|
||||
(setq sp (point)) ; saved point
|
||||
(setq sm (mark t)) ; saved mark
|
||||
;;; (set-buffer (window-buffer (posn-window (event-start event))))
|
||||
;;; (setq mouse (goto-char (posn-point (event-start event))))
|
||||
(setq mouse (point)) ;; ess-mouse-me-helper
|
||||
;; if there is a region and point is inside it
|
||||
;; check for sm first incase (null (mark t))
|
||||
;; set name to either the thing they clicked on or region
|
||||
(if (and sm
|
||||
(or (and transient-mark-mode mark-active)
|
||||
(eq last-command 'mouse-drag-region))
|
||||
(>= mouse (setq beg (min sp sm)))
|
||||
(<= mouse (setq end (max sp sm))))
|
||||
(setq name (buffer-substring beg end))
|
||||
(setq name (funcall mouse-me-get-string-function))
|
||||
(if (listp name)
|
||||
(setq beg (nth 1 name)
|
||||
end (nth 2 name)
|
||||
name (car name))
|
||||
(goto-char mouse)
|
||||
(while (not (looking-at (regexp-quote name)))
|
||||
(backward-char 1))
|
||||
(setq beg (point))
|
||||
(setq end (search-forward name))))))
|
||||
;; check if name is null, meaning they clicked on no word
|
||||
(if (or (null name)
|
||||
(and (stringp name) (string= name "" )))
|
||||
(error "No string to pass to function"))
|
||||
;; popup a menu to get a command to run
|
||||
(setq cmd (funcall func name))
|
||||
;; run the command, eval'ing if it was a list
|
||||
(if (listp cmd)
|
||||
(setq cmd (eval cmd)))
|
||||
(setq mmtype (get cmd 'mouse-me-type))
|
||||
(cond ((eq mmtype 'region)
|
||||
(funcall cmd beg end))
|
||||
((eq mmtype 'string)
|
||||
(funcall cmd name))
|
||||
(t
|
||||
(funcall cmd name)))))
|
||||
|
||||
(defcustom ess-S-mouse-me-menu-commands-alist
|
||||
'("S-Plus 4 and 6 GUI under Windows"
|
||||
("Edit.data" . ess-mouse-me-Edit.data)
|
||||
"----"
|
||||
("print" . ess-mouse-me-print)
|
||||
("summary" . ess-mouse-me-summary)
|
||||
("plot" . ess-mouse-me-plot)
|
||||
("show" . ess-mouse-me-show)
|
||||
("help" . ess-display-help-on-object)
|
||||
("args" . ess-mouse-me-args)
|
||||
"----"
|
||||
("Browser on" . ess-mouse-me-browser-on)
|
||||
("Browser off" . ess-mouse-me-browser-off))
|
||||
"Command menu used by `mouse-me-build-menu'.
|
||||
A alist of elements where each element is either a cons cell or a string.
|
||||
If a cons cell the car is a string to be displayed in the menu and the
|
||||
cdr is either a function to call passing a string to, or a list which evals
|
||||
to a function to call passing a string to. If the element is a string
|
||||
it makes a non-selectable element in the menu. To make a separator line
|
||||
use a string consisting solely of hyphens.
|
||||
|
||||
The function returned from this menu will be called with one string
|
||||
argument. Or if the function has the symbol property `mouse-me-type'
|
||||
and if its value is the symbol `region' it will be called with the
|
||||
beginning and ending points of the selected string. If the value is
|
||||
the symbol `string' it will be called with one string argument."
|
||||
:type '(repeat sexp)
|
||||
:group 'mouseme)
|
||||
|
||||
|
||||
(defun ess-mouse-me-Edit.data (string)
|
||||
(ess-mouse-me-eval-expanded string "Edit.data(" ")" nil nil nil))
|
||||
|
||||
(defun ess-mouse-me-print (string)
|
||||
(ess-mouse-me-eval-expanded string "" "" nil nil t))
|
||||
(defun ess-mouse-me-summary (string)
|
||||
(ess-mouse-me-eval-expanded string "summary(" ")" nil nil t))
|
||||
(defun ess-mouse-me-plot (string)
|
||||
(ess-mouse-me-eval-expanded string "plot(" ")") nil nil nil)
|
||||
(defun ess-mouse-me-show (string)
|
||||
(ess-mouse-me-eval-expanded string "show(" ")") nil nil nil)
|
||||
(defun ess-mouse-me-args (string)
|
||||
(ess-mouse-me-eval-expanded string "args(" ")" nil nil t))
|
||||
|
||||
(defun ess-mouse-me-browser-on (string)
|
||||
(if (equal (substring ess-dialect 0 1) "R")
|
||||
(ess-eval-linewise (concat "debug(" string ")"))
|
||||
(ess-mouse-me-eval-expanded string "trace(" ", exit=browser)") nil nil nil))
|
||||
|
||||
(defun ess-mouse-me-browser-off (string)
|
||||
(if (equal (substring ess-dialect 0 1) "R")
|
||||
(ess-eval-linewise (concat "undebug(" string ")"))
|
||||
(ess-mouse-me-eval-expanded string "untrace(" ")") nil nil nil))
|
||||
|
||||
|
||||
|
||||
(defun ess-mouse-me-eval-expanded (string &optional head tail commands-buffer
|
||||
page value-returned)
|
||||
"Send the expanded STRING to the inferior-ess process using `ess-command'
|
||||
after first concating the HEAD and TAIL. Put answer in COMMANDS-BUFFER if
|
||||
specified, otherwise in \"tmp-buffer\". In either
|
||||
case the buffer containing the answer is renamed to the value of the
|
||||
constructed command. If PAGE is non-nil, expand
|
||||
the string one more time by embedding it in a \"page()\" command."
|
||||
(interactive)
|
||||
(let* (scommand
|
||||
page-scommand
|
||||
(lproc-name ess-local-process-name)
|
||||
(ess-mouse-customize-alist ess-local-customize-alist))
|
||||
(if (not head) (setq head "summary("))
|
||||
(if (not tail) (setq tail ")"))
|
||||
(if (not commands-buffer) (setq commands-buffer
|
||||
(get-buffer-create "tmp-buffer")))
|
||||
(setq scommand (concat head string tail))
|
||||
|
||||
(ess-make-buffer-current)
|
||||
(pop-to-buffer-same-window commands-buffer)
|
||||
(ess-setq-vars-local (eval ess-mouse-customize-alist) (current-buffer))
|
||||
(setq ess-local-process-name lproc-name)
|
||||
(ess-command (concat scommand "\n") commands-buffer)
|
||||
(if (not value-returned) (pop-to-buffer-same-window (nth 1 (buffer-list))))
|
||||
(if (not value-returned)
|
||||
nil
|
||||
(if ess-microsoft-p ;; there ought to be a filter
|
||||
(while (search-forward "\r" nil t) ;; function to keep the ^M
|
||||
(replace-match "" nil t))) ;; from showing up at all
|
||||
(ess-transcript-mode)
|
||||
(setq ess-local-process-name lproc-name)
|
||||
(rename-buffer scommand))))
|
||||
|
||||
|
||||
; Provide package
|
||||
|
||||
(provide 'ess-mouse)
|
||||
|
||||
|
||||
|
||||
;;;;;;;; STARTUP STUFF ;;;;;;;;;;;;
|
||||
|
||||
(make-variable-buffer-local 'mouse-me-menu-commands)
|
||||
|
||||
(defun ess-S-mouse-me-menu-commands ()
|
||||
(if (equal ess-language "S")
|
||||
(setq mouse-me-menu-commands ess-S-mouse-me-menu-commands-alist)))
|
||||
|
||||
;; (define-key ess-mode-map [S-mouse-3] 'ess-mouse-me)
|
||||
;; (define-key inferior-ess-mode-map [S-mouse-3] 'ess-mouse-me)
|
||||
;; (defun ess-S-mouse-me-ess-transcript-mode ()
|
||||
;; (define-key ess-transcript-mode-map [S-mouse-3] 'ess-mouse-me))
|
||||
;;
|
||||
(add-hook 'ess-mode-hook 'ess-S-mouse-me-menu-commands)
|
||||
(add-hook 'inferior-ess-mode-hook 'ess-S-mouse-me-menu-commands)
|
||||
(add-hook 'ess-transcript-mode-hook 'ess-S-mouse-me-menu-commands)
|
||||
;; (add-hook 'ess-transcript-mode-hook 'ess-S-mouse-me-ess-transcript-mode)
|
||||
|
||||
|
||||
;;; ess-mouse.el ends here
|
||||
153
lisp/ess/obsolete/ess-r-a.el
Normal file
153
lisp/ess/obsolete/ess-r-a.el
Normal file
@@ -0,0 +1,153 @@
|
||||
;;; ess-r-a.el -- Possible local customizations for R with ESS. -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 1997-2020 Free Software Foundation, Inc.
|
||||
;; Author: A.J. Rossini <blindglobe@gmail.com>
|
||||
;; Created: 17 November 1999
|
||||
;; Maintainer: ESS-core <ESS-core@r-project.org>
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;;; License:
|
||||
;;
|
||||
;; This program 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 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
;;
|
||||
;; This program 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.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see
|
||||
;; <http://www.gnu.org/licenses/>
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; The purpose of this file is to demonstrate some of the extras that
|
||||
;; have been constructed for the ESS R mode; if they prove
|
||||
;; interesting, then they might be migrated to ess-r-mode, the primary
|
||||
;; ESS R mode tools.
|
||||
|
||||
;;; Code:
|
||||
(require 'ess-inf)
|
||||
(require 'ess-r-mode)
|
||||
|
||||
;; you can invoke ESS/R from emacs by typing
|
||||
;; C-u M-x essr
|
||||
;; with vsize set to (for example) 40M, and nsize set to 600000.
|
||||
|
||||
;; Undefined on non-apple devices
|
||||
(declare-function ns-do-applescript "nsfns.m" (script))
|
||||
(declare-function do-applescript "ess-r-a" (script))
|
||||
(unless (fboundp 'do-applescript)
|
||||
(defalias 'do-applescript 'ns-do-applescript))
|
||||
|
||||
(defalias 'essr
|
||||
(read-kbd-macro
|
||||
"C-u M-x R RET - - vsize = 40M SPC - - nsize = 600000 2*RET"))
|
||||
|
||||
(defun ess-r-do-region (start end)
|
||||
"Send from START to END to R via AppleScript."
|
||||
(interactive "r\nP")
|
||||
(message "Starting evaluation...")
|
||||
(do-applescript (concat
|
||||
"try\n"
|
||||
"tell application \"R\"\n"
|
||||
"activate\n"
|
||||
"with timeout of 0 seconds\n"
|
||||
"cmd \"" (buffer-substring start end)
|
||||
"\"\n"
|
||||
"end timeout\n"
|
||||
"end tell\n"
|
||||
"end try\n"))
|
||||
(message "Finished evaluation"))
|
||||
|
||||
(defun ess-r-do-line ()
|
||||
"Send the current line to R via AppleScript."
|
||||
(interactive) ;; "r\nP")
|
||||
(message "Starting evaluation...")
|
||||
(save-excursion
|
||||
(let ((end (point)))
|
||||
(move-to-column 0)
|
||||
(do-applescript (concat
|
||||
"try\n"
|
||||
"tell application \"R\"\n"
|
||||
"activate\n"
|
||||
"with timeout of 0 seconds\n"
|
||||
"cmd \"" (buffer-substring (point) end)
|
||||
"\"\n"
|
||||
"end timeout\n"
|
||||
"end tell\n"
|
||||
"end try\n"))))
|
||||
(message "Finished evaluation"))
|
||||
|
||||
(defun ess-r-var (beg end)
|
||||
"Load the current region of numbers into an R variable.
|
||||
Prompts for a variable name. If none is given, it uses a default
|
||||
variable name, e. BEG and END denote the region in the current
|
||||
buffer to be sent."
|
||||
(interactive "r")
|
||||
(save-window-excursion
|
||||
(let ((tmp-file (make-temp-file "ess-r-var"))
|
||||
cmd
|
||||
var)
|
||||
(write-region beg end tmp-file)
|
||||
|
||||
;; Decide on the variable name to use in R; could use completion.
|
||||
(setq var (read-string "R Variable name (default e): "))
|
||||
(if (equal var "")
|
||||
(setq var "e"))
|
||||
|
||||
;; Command to send to the R process. Get R to delete the file
|
||||
;; rather than Emacs in case it takes R a long time to run the
|
||||
;; scan command.
|
||||
(setq cmd (concat var " <- scan(\"" tmp-file "\"); "
|
||||
"unlink(\"" tmp-file "\")" ))
|
||||
|
||||
;; Put the output from the scan command into the process buffer so
|
||||
;; the user has a record of it.
|
||||
(ess-execute cmd 'buffer))))
|
||||
|
||||
|
||||
;;; Peter Dalgaard's code.
|
||||
;;; This needs to be cleaned and validated!
|
||||
|
||||
(defun pd::set-up-demo ()
|
||||
(run-ess-r)
|
||||
(split-window-vertically 6)
|
||||
(find-file "demos.R")
|
||||
|
||||
;; Don't need to run this as a function -- ought to be fine if set
|
||||
;; just once.
|
||||
|
||||
(defun ajr::scroll-to-end::peterD (emacs)
|
||||
"Goal: map prompt to bottom of the screen after every command.
|
||||
Alternatively, use the scroll-in-place package, not sure where that
|
||||
is)."
|
||||
(interactive)
|
||||
(other-buffer 1)
|
||||
(if (= emacs "emacs")
|
||||
(setq scroll-up-aggressively t)
|
||||
(setq scroll-conservatively -4)) ;; <- change this
|
||||
(other-buffer -1))
|
||||
|
||||
(defun show-max-other-window ()
|
||||
(interactive)
|
||||
(other-window 1)
|
||||
(comint-show-maximum-output)
|
||||
(other-window -1))
|
||||
|
||||
;; call this once
|
||||
;; (ajr::scroll-to-end::peterD "emacs")
|
||||
|
||||
(global-set-key [f11] 'show-max-other-window)
|
||||
(global-set-key [f12] 'ess-eval-line-visibly-and-step))
|
||||
|
||||
|
||||
; Provide package
|
||||
|
||||
(provide 'ess-r-a)
|
||||
|
||||
;;; ess-r-a.el ends here
|
||||
233
lisp/ess/obsolete/make-regexp.el
Normal file
233
lisp/ess/obsolete/make-regexp.el
Normal file
@@ -0,0 +1,233 @@
|
||||
;;; make-regexp.el --- generate efficient regexps to match strings.
|
||||
|
||||
;; Copyright (C) 1994-2020 Free Software Foundation, Inc.
|
||||
;; Author: Simon Marshall <simon@gnu.ai.mit.edu>
|
||||
;; Keywords: lisp, matching
|
||||
;; Version: 1.02
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;;; License:
|
||||
;;
|
||||
;; This program 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 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
;;
|
||||
;; This program 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.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see
|
||||
;; <http://www.gnu.org/licenses/>
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Purpose:
|
||||
;;
|
||||
;; To make efficient regexps from lists of strings.
|
||||
|
||||
;; For example:
|
||||
;;
|
||||
;; (let ((strings '("cond" "if" "while" "let\\*?" "prog1" "prog2" "progn"
|
||||
;; "catch" "throw" "save-restriction" "save-excursion"
|
||||
;; "save-window-excursion" "save-match-data"
|
||||
;; "unwind-protect" "condition-case" "track-mouse")))
|
||||
;; (concat "(" (make-regexp strings t)))
|
||||
;;
|
||||
;; => "(\\(c\\(atch\\|ond\\(\\|ition-case\\)\\)\\|if\\|let\\*?\\|prog[12n]\\|save-\\(excursion\\|match-data\\|restriction\\|window-excursion\\)\\|t\\(hrow\\|rack-mouse\\)\\|unwind-protect\\|while\\)"
|
||||
;;
|
||||
;; To search for the above regexp takes about 70% of the time as for the simple
|
||||
;; (concat "(\\(" (mapconcat 'identity strings "\\|") "\\)") regexp.
|
||||
;;
|
||||
;; Obviously, the more the similarity between strings, the faster the regexp:
|
||||
;;
|
||||
;; (make-regexp '("abort" "abs" "accept" "access" "array" "begin" "body" "case"
|
||||
;; "constant" "declare" "delay" "delta" "digits" "else" "elsif"
|
||||
;; "entry" "exception" "exit" "function" "generic" "goto" "if"
|
||||
;; "others" "limited" "loop" "mod" "new" "null" "out" "subtype"
|
||||
;; "package" "pragma" "private" "procedure" "raise" "range"
|
||||
;; "record" "rem" "renames" "return" "reverse" "select"
|
||||
;; "separate" "task" "terminate" "then" "type" "when" "while"
|
||||
;; "with" "xor"))
|
||||
;;
|
||||
;; => "a\\(b\\(ort\\|s\\)\\|cce\\(pt\\|ss\\)\\|rray\\)\\|b\\(egin\\|ody\\)\\|c\\(ase\\|onstant\\)\\|d\\(e\\(clare\\|l\\(ay\\|ta\\)\\)\\|igits\\)\\|e\\(ls\\(e\\|if\\)\\|ntry\\|x\\(ception\\|it\\)\\)\\|function\\|g\\(eneric\\|oto\\)\\|if\\|l\\(imited\\|oop\\)\\|mod\\|n\\(ew\\|ull\\)\\|o\\(thers\\|ut\\)\\|p\\(ackage\\|r\\(agma\\|ivate\\|ocedure\\)\\)\\|r\\(a\\(ise\\|nge\\)\\|e\\(cord\\|m\\|names\\|turn\\|verse\\)\\)\\|s\\(e\\(lect\\|parate\\)\\|ubtype\\)\\|t\\(ask\\|erminate\\|hen\\|ype\\)\\|w\\(h\\(en\\|ile\\)\\|ith\\)\\|xor"
|
||||
;;
|
||||
;; To search for the above regexp takes less than 60% of the time of the simple
|
||||
;; mapconcat equivalent.
|
||||
;;
|
||||
;; But even small regexps may be worth it:
|
||||
;;
|
||||
;; (make-regexp '("and" "at" "do" "end" "for" "in" "is" "not" "of" "or" "use"))
|
||||
;; => "a\\(nd\\|t\\)\\|do\\|end\\|for\\|i[ns]\\|not\\|o[fr]\\|use"
|
||||
;;
|
||||
;; as this is 10% faster than the mapconcat equivalent.
|
||||
|
||||
;; Installation:
|
||||
;;
|
||||
;; (autoload 'make-regexp "make-regexp"
|
||||
;; "Return a regexp to match a string item in STRINGS.")
|
||||
;;
|
||||
;; (autoload 'make-regexps "make-regexp"
|
||||
;; "Return a regexp to REGEXPS.")
|
||||
;;
|
||||
;; Since these functions were written to produce efficient regexps, not regexps
|
||||
;; efficiently, it is probably not a good idea to in-line too many calls in
|
||||
;; your code, unless you use the following neat trick with `eval-when-compile':
|
||||
;;
|
||||
;; (defvar definition-regexp
|
||||
;; (let ((regexp (eval-when-compile
|
||||
;; (make-regexp '("defun" "defsubst" "defmacro" "defalias"
|
||||
;; "defvar" "defconst" "defadvice") t))))
|
||||
;; (concat "^(" regexp)))
|
||||
;;
|
||||
;; The `byte-compile' code will be as if you had defined the variable thus:
|
||||
;;
|
||||
;; (defvar definition-regexp
|
||||
;; "^(\\(def\\(a\\(dvice\\|lias\\)\\|const\\|macro\\|subst\\|un\\|var\\)\\)")
|
||||
|
||||
;; Feedback:
|
||||
;;
|
||||
;; Originally written for font-lock, from an idea from Stig's hl319.
|
||||
;; Please don't tell me that it doesn't produce optimal regexps; I know that
|
||||
;; already. But (ideas or) code to improve things (are) is welcome. Please
|
||||
;; test your code and tell me the speed up in searching an appropriate buffer.
|
||||
;;
|
||||
;; Please send me bug reports, bug fixes, and extensions, etc.
|
||||
;; Simon Marshall <simon@gnu.ai.mit.edu>
|
||||
|
||||
;; History:
|
||||
;;
|
||||
;; 1.00--1.01:
|
||||
;; - Made `make-regexp' take `lax' to force top-level parentheses.
|
||||
;; - Fixed `make-regexps' for MATCH bug and new `font-lock-keywords'.
|
||||
;; - Added `unfontify' to user timing functions.
|
||||
;; 1.01--1.02:
|
||||
;; - Made `make-regexp' `let' a big `max-lisp-eval-depth'.
|
||||
|
||||
;; The basic idea is to find the shortest common non-"" prefix each time, and
|
||||
;; squirrel it out. If there is no such prefix, we divide the list into two so
|
||||
;; that (at least) one half will have at least a one-character common prefix.
|
||||
|
||||
;; In addition, we (a) delay the addition of () parenthesis as long as possible
|
||||
;; (until we're sure we need them), and (b) try to squirrel out one-character
|
||||
;; sequences (so we can use [] rather than ()).
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defun make-regexp (strings &optional paren lax)
|
||||
"Return a regexp to match a string item in STRINGS.
|
||||
If optional PAREN non-nil, output regexp parentheses around returned regexp.
|
||||
If optional LAX non-nil, don't output parentheses if it doesn't require them.
|
||||
Merges keywords to avoid backtracking in Emacs' regexp matcher."
|
||||
(let* ((max-lisp-eval-depth (* 1024 1024))
|
||||
(strings (let ((l strings)) ; Paranoia---make strings unique!
|
||||
(while l (setq l (setcdr l (delete (car l) (cdr l)))))
|
||||
(sort strings 'string-lessp)))
|
||||
(open-paren (if paren "\\(" "")) (close-paren (if paren "\\)" ""))
|
||||
(open-lax (if lax "" open-paren)) (close-lax (if lax "" close-paren))
|
||||
(completion-ignore-case nil))
|
||||
(cond
|
||||
;; If there's only one string, just return it.
|
||||
((= (length strings) 1)
|
||||
(concat open-lax (car strings) close-lax))
|
||||
;; If there's an empty string, pull it out.
|
||||
((string= (car strings) "")
|
||||
(if (and (= (length strings) 2) (= (length (nth 1 strings)) 1))
|
||||
(concat open-lax (nth 1 strings) "?" close-lax)
|
||||
(concat open-paren "\\|" (make-regexp (cdr strings)) close-paren)))
|
||||
;; If there are only one-character strings, make a [] list instead.
|
||||
((= (length strings) (apply '+ (mapcar 'length strings)))
|
||||
(concat open-lax "[" (mapconcat 'identity strings "") "]" close-lax))
|
||||
(t
|
||||
;; We have a list of strings. Is there a common prefix?
|
||||
(let ((prefix (try-completion "" (mapcar 'list strings))))
|
||||
(if (> (length prefix) 0)
|
||||
;; Common prefix! Squirrel it out and recurse with the suffixes.
|
||||
(let* ((len (length prefix))
|
||||
(sufs (mapcar (lambda (str) (substring str len)) strings)))
|
||||
(concat open-paren prefix (make-regexp sufs t t) close-paren))
|
||||
;; No common prefix. Is there a one-character sequence?
|
||||
(let ((letters (let ((completion-regexp-list '("^.$")))
|
||||
(all-completions "" (mapcar 'list strings)))))
|
||||
(if (> (length letters) 1)
|
||||
;; Do the one-character sequences, then recurse on the rest.
|
||||
(let ((rest (let ((completion-regexp-list '("^..+$")))
|
||||
(all-completions "" (mapcar 'list strings)))))
|
||||
(concat open-paren
|
||||
(make-regexp letters) "\\|" (make-regexp rest)
|
||||
close-paren))
|
||||
;; No one-character sequence, so divide the list into two by
|
||||
;; dividing into those that start with a particular letter, and
|
||||
;; those that do not.
|
||||
(let* ((char (substring (car strings) 0 1))
|
||||
(half1 (all-completions char (mapcar 'list strings)))
|
||||
(half2 (nthcdr (length half1) strings)))
|
||||
(concat open-paren
|
||||
(make-regexp half1) "\\|" (make-regexp half2)
|
||||
close-paren))))))))))
|
||||
|
||||
;; This stuff is realy for font-lock...
|
||||
|
||||
;; Ahhh, the wonders of lisp...
|
||||
(defun regexp-span (regexp &optional start)
|
||||
"Return the span or depth of REGEXP.
|
||||
This means the number of \"\\\\(...\\\\)\" pairs in REGEXP, optionally from START."
|
||||
(let ((match (string-match (regexp-quote "\\(") regexp (or start 0))))
|
||||
(if (not match) 0 (1+ (regexp-span regexp (match-end 0))))))
|
||||
|
||||
;; The basic idea is to concat the regexps together, keeping count of the span
|
||||
;; of the regexps so that we can get the correct match for hilighting.
|
||||
(defun make-regexps (&rest regexps)
|
||||
"Return a regexp to match REGEXPS
|
||||
Each item of REGEXPS should be of the form:
|
||||
|
||||
STRING ; A STRING to be used literally.
|
||||
(STRING MATCH FACE DATA) ; Match STRING at depth MATCH with FACE
|
||||
; and highlight according to DATA.
|
||||
(STRINGS FACE DATA) ; STRINGS is a list of strings FACE is
|
||||
; to highlight according to DATA.
|
||||
|
||||
Returns a list of the form:
|
||||
|
||||
(REGEXP (MATCH FACE DATA) ...)
|
||||
|
||||
For example:
|
||||
|
||||
(make-regexps \"^(\"
|
||||
'((\"defun\" \"defalias\" \"defsubst\" \"defadvice\") keyword)
|
||||
\"[ \t]*\"
|
||||
'(\"\\\\([a-zA-Z-]+\\\\)?\" 1 function-name nil t))
|
||||
|
||||
=>
|
||||
|
||||
(\"^(\\\\(def\\\\(a\\\\(dvice\\\\|lias\\\\)\\\\|subst\\\\|un\\\\)\\\\)[ ]*\\\\([a-zA-Z-]+\\\\)?\"
|
||||
(1 keyword) (4 function-name nil t))
|
||||
|
||||
Uses `make-regexp' to make efficient regexps."
|
||||
(let ((regexp "") (data ()))
|
||||
(while regexps
|
||||
(cond ((stringp (car regexps))
|
||||
(setq regexp (concat regexp (car regexps))))
|
||||
((stringp (nth 0 (car regexps)))
|
||||
(setq data (cons (cons (+ (regexp-span regexp)
|
||||
(nth 1 (car regexps)))
|
||||
(nthcdr 2 (car regexps)))
|
||||
data)
|
||||
regexp (concat regexp (nth 0 (car regexps)))))
|
||||
(t
|
||||
(setq data (cons (cons (1+ (regexp-span regexp))
|
||||
(cdr (car regexps)))
|
||||
data)
|
||||
regexp (concat regexp (make-regexp (nth 0 (car regexps))
|
||||
t)))))
|
||||
(setq regexps (cdr regexps)))
|
||||
(cons regexp (nreverse data))))
|
||||
|
||||
;; timing functions removed due to name collisions with Gnus
|
||||
|
||||
(provide 'make-regexp)
|
||||
|
||||
;;; make-regexp.el ends here
|
||||
358
lisp/ess/obsolete/mouseme.el
Normal file
358
lisp/ess/obsolete/mouseme.el
Normal file
@@ -0,0 +1,358 @@
|
||||
;;; mouseme.el --- mouse menu with commands that operate on strings
|
||||
|
||||
;; Copyright (C) 1997-2020 by Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Howard Melman <howard@silverstream.com>
|
||||
;; Keywords: mouse, menu
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;;; License:
|
||||
;;
|
||||
;; This program 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 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
;;
|
||||
;; This program 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.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see
|
||||
;; <http://www.gnu.org/licenses/>
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This package provides a command `mouse-me' to be bound to a mouse
|
||||
;; button. It pops up a menu of commands that operate on strings or a
|
||||
;; region. The string passed to the selected command is the word or
|
||||
;; symbol clicked on (with surrounding quotes or other punctuation
|
||||
;; removed), or the region (if either it was just selected with the
|
||||
;; mouse or if it was active with `transient-mark-mode' on). If the
|
||||
;; command accepts a region, the selected region (or the region of the
|
||||
;; word or symbol clicked on) will be passed to the command.
|
||||
|
||||
;; The idea is that for any given string in a buffer you may want to
|
||||
;; do different things regardless of the mode of the buffer. URLs
|
||||
;; now appear in email, news articles, comments in code, and in plain
|
||||
;; text. You may want to visit that URL in a browser or you may just
|
||||
;; want to copy it to the kill-ring. For an email address you might
|
||||
;; want to compose mail to it, finger it, look it up in bbdb, copy it to
|
||||
;; the kill ring. For a word you may want to spell check it, copy it,
|
||||
;; change its case, grep for it, etc. Mouse-me provides a menu to
|
||||
;; make this easy.
|
||||
|
||||
;; The menu popped up is generated by calling the function in the
|
||||
;; variable `mouse-me-build-menu-function' which defaults to calling
|
||||
;; `mouse-me-build-menu' which builds the menu from the variable
|
||||
;; `mouse-me-menu-commands'. See the documentation for these
|
||||
;; functions and variables for details.
|
||||
|
||||
;; To install, add something like the following to your ~/.emacs:
|
||||
;; (require 'mouseme)
|
||||
;; (global-set-key [S-mouse-2] 'mouse-me)
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'browse-url)
|
||||
(require 'thingatpt)
|
||||
|
||||
(eval-when-compile (require 'compile))
|
||||
|
||||
;;;; Variables
|
||||
|
||||
(defgroup mouseme nil
|
||||
"Popup menu of commands that work on strings."
|
||||
:prefix "mouse-me-"
|
||||
:group 'hypermedia)
|
||||
|
||||
(defcustom mouse-me-get-string-function 'mouse-me-get-string
|
||||
"Function used by `mouse-me' to get string when no region selected.
|
||||
The default is `mouse-me-get-string' but this variable may commonly
|
||||
be made buffer local and set to something more appropriate for
|
||||
a specific mode (e.g., `word-at-point'). The function will be called
|
||||
with no arguments and with point at where the mouse was clicked.
|
||||
It can return either the string or to be most efficient, a list of
|
||||
three elements: the string and the beginning and ending points of the
|
||||
string in the buffer."
|
||||
:type 'function
|
||||
:options '(mouse-me-get-string)
|
||||
:group 'mouseme)
|
||||
|
||||
(defcustom mouse-me-build-menu-function 'mouse-me-build-menu
|
||||
"Function used by `mouse-me' to build the popup menu.
|
||||
The default is `mouse-me-build-menu' but this variable may commonly
|
||||
be made buffer local and set to something more appropriate for
|
||||
a specific mode. The function will be called with one argument,
|
||||
the string selected, as returned by `mouse-me-get-string-function'."
|
||||
:type 'function
|
||||
:options '(mouse-me-build-menu)
|
||||
:group 'mouseme)
|
||||
|
||||
(defvar mouse-me-grep-use-extension 't
|
||||
"If non-nil `mouse-me-grep' grep's in files with current file's extension.")
|
||||
|
||||
(defcustom mouse-me-menu-commands
|
||||
'(("Copy" . kill-new)
|
||||
("Kill" . kill-region)
|
||||
("Capitalize" . capitalize-region)
|
||||
("Lowercase" . downcase-region)
|
||||
("Uppercase" . upcase-region)
|
||||
("ISpell" . ispell-region)
|
||||
"----"
|
||||
("Browse URL" . browse-url)
|
||||
("Dired" . dired)
|
||||
("Execute File" . mouse-me-execute)
|
||||
("Mail to" . compose-mail)
|
||||
("Finger" . mouse-me-finger)
|
||||
("BBDB Lookup" . mouse-me-bbdb)
|
||||
"----"
|
||||
("Imenu" . imenu)
|
||||
("Find Tag" . find-tag)
|
||||
("Grep" . mouse-me-grep)
|
||||
("Find-Grep" . mouse-me-find-grep)
|
||||
"----"
|
||||
("Apropos" . apropos)
|
||||
("Describe Function" . mouse-me-describe-function)
|
||||
("Describe Variable" . mouse-me-describe-variable)
|
||||
("Command Info" . mouse-me-emacs-command-info)
|
||||
("Man Page" . (if (fboundp 'woman) 'woman 'man))
|
||||
("Profile Function" . mouse-me-elp-instrument-function))
|
||||
"Command menu used by `mouse-me-build-menu'.
|
||||
A list of elements where each element is either a cons cell or a string.
|
||||
If a cons cell the car is a string to be displayed in the menu and the
|
||||
cdr is either a function to call passing a string to, or a list which evals
|
||||
to a function to call passing a string to. If the element is a string
|
||||
it makes a non-selectable element in the menu. To make a separator line
|
||||
use a string consisting solely of hyphens.
|
||||
|
||||
The function returned from this menu will be called with one string
|
||||
argument. Or if the function has the symbol property `mouse-me-type'
|
||||
and if its value is the symbol `region' it will be called with the
|
||||
beginning and ending points of the selected string. If the value is
|
||||
the symbol `string' it will be called with one string argument."
|
||||
:type '(repeat sexp)
|
||||
:group 'mouseme)
|
||||
|
||||
(put 'kill-region 'mouse-me-type 'region)
|
||||
(put 'ispell-region 'mouse-me-type 'region)
|
||||
(put 'capitalize-region 'mouse-me-type 'region)
|
||||
(put 'downcase-region 'mouse-me-type 'region)
|
||||
(put 'upcase-region 'mouse-me-type 'region)
|
||||
|
||||
;;;; Commands
|
||||
|
||||
;;;###autoload
|
||||
(defun mouse-me (event)
|
||||
"Popup a menu of functions to run on selected string or region."
|
||||
(interactive "e")
|
||||
(mouse-me-helper event (lambda (name)
|
||||
(or (x-popup-menu event (funcall mouse-me-build-menu-function name))
|
||||
(error "No command to run")))))
|
||||
|
||||
;;;; Exposed Functions
|
||||
|
||||
;; Some tests:
|
||||
;; <URL:http://foo.bar.com/sss/ss.html>
|
||||
;; <http://foo.bar.com/sss/ss.html>
|
||||
;; http://foo.bar.com/sss/ss.html
|
||||
;; http://www.ditherdog.com/howard/
|
||||
;; mailto:howard@silverstream.com
|
||||
;; howard@silverstream.com
|
||||
;; <howard@silverstream.com>
|
||||
;; import com.sssw.srv.agents.AgentsRsrc;
|
||||
;; public AgoHttpRequestEvent(Object o, String db, Request r)
|
||||
;; <DIV><A href=3D"http://www.amazon.com/exec/obidos/ASIN/156592391X"><IMG =
|
||||
;; <A HREF="http://www.suntimes.com/ebert/ebert.html">
|
||||
;; d:\howard\elisp\spoon
|
||||
;; \howard\elisp\spoon
|
||||
;; \\absolut\howard\elisp\spoon
|
||||
;; //absolut/d/Howard/Specs/servlet-2.1.pdf
|
||||
;; \\absolut\d\Howard\Specs\servlet-2.1.pdf
|
||||
;; gnuserv-frame.
|
||||
|
||||
(defun mouse-me-get-string ()
|
||||
"Return a string from the buffer of text surrounding point.
|
||||
Returns a list of three elements, the string and the beginning and
|
||||
ending positions of the string in the buffer in that order."
|
||||
(save-match-data
|
||||
(save-excursion
|
||||
(let ((start (point)) beg end str p)
|
||||
(skip-syntax-forward "^ >()\"")
|
||||
(setq end (point))
|
||||
(goto-char start)
|
||||
(skip-syntax-backward "^ >()\"")
|
||||
(setq beg (point))
|
||||
(setq str (buffer-substring-no-properties beg end))
|
||||
;; remove junk from the beginning
|
||||
(if (string-match "^\\([][\"'`.,?:;!@#$%^&*()_+={}|<>-]+\\)" str)
|
||||
(setq str (substring str (match-end 1))
|
||||
beg (+ beg (match-end 1))))
|
||||
;; remove URL: from the front, it's common in email
|
||||
(if (string-match "^\\(URL:\\)" str)
|
||||
(setq str (substring str (match-end 1))
|
||||
beg (+ beg (match-end 1))))
|
||||
;; remove junk from the end
|
||||
(if (string-match "\\([][\"'.,?:;!@#$%^&*()_+={}|<>-]+\\)$" str)
|
||||
(setq end (- end (length (match-string 1 str))) ; must set end first
|
||||
str (substring str 0 (match-beginning 1))))
|
||||
(list str beg end)))))
|
||||
|
||||
(defun mouse-me-build-menu (name)
|
||||
"Return a menu tailored for NAME for `mouse-me' from `mouse-me-menu-commands'."
|
||||
(list "Mouse Me" (cons "Mouse Me"
|
||||
(append (list (cons
|
||||
(if (< (length name) 65)
|
||||
name
|
||||
"...Long String...")
|
||||
'kill-new)
|
||||
"---")
|
||||
mouse-me-menu-commands))))
|
||||
|
||||
;;;; Commands for the menu
|
||||
|
||||
(defun mouse-me-emacs-command-info (string)
|
||||
"Look in Emacs info for command named STRING."
|
||||
(interactive "sCommand: ")
|
||||
(let ((s (intern-soft string)))
|
||||
(if (and s (commandp s))
|
||||
(Info-goto-emacs-command-node s)
|
||||
(error "No command named `%s'" string))))
|
||||
|
||||
(defun mouse-me-describe-function (string)
|
||||
"Describe function named STRING."
|
||||
(interactive "sFunction: ")
|
||||
(let ((s (intern-soft string)))
|
||||
(if (and s (fboundp s))
|
||||
(describe-function s)
|
||||
(error "No function named `%s'" string))))
|
||||
|
||||
(defun mouse-me-describe-variable (string)
|
||||
"Desribe variable named STRING."
|
||||
(interactive "sVariable: ")
|
||||
(let ((s (intern-soft string)))
|
||||
(if (and s (boundp s))
|
||||
(describe-variable s)
|
||||
(error "No variable named `%s'" string))))
|
||||
|
||||
(defun mouse-me-elp-instrument-function (string)
|
||||
"Instrument Lisp function named STRING."
|
||||
(interactive "sFunction: ")
|
||||
(let ((s (intern-soft string)))
|
||||
(if (and s (fboundp s))
|
||||
(elp-instrument-function s)
|
||||
(error "Must be the name of an existing Lisp function"))))
|
||||
|
||||
(defun mouse-me-execute (string)
|
||||
"Execute STRING as a filename."
|
||||
(interactive "sFile: ")
|
||||
(if (fboundp 'w32-shell-execute)
|
||||
(w32-shell-execute "open" (convert-standard-filename string))
|
||||
(message "This function currently working only in W32.")))
|
||||
|
||||
|
||||
(defun mouse-me-bbdb (string)
|
||||
"Lookup STRING in bbdb."
|
||||
(interactive "sBBDB Lookup: ")
|
||||
(if (fboundp 'bbdb)
|
||||
(bbdb string nil)
|
||||
(error "BBDB not loaded")))
|
||||
|
||||
(defun mouse-me-finger (string)
|
||||
"Finger a STRING mail address."
|
||||
(interactive "sFinger: ")
|
||||
(save-match-data
|
||||
(if (string-match "\\(.*\\)@\\([-.a-zA-Z0-9]+\\)$" string)
|
||||
(finger (match-string 1 string) (match-string 2 string))
|
||||
(error "Not in user@host form: %s" string))))
|
||||
|
||||
(defun mouse-me-grep (string)
|
||||
"Grep for a STRING."
|
||||
(interactive "sGrep: ")
|
||||
(require 'compile)
|
||||
(grep-compute-defaults)
|
||||
(let ((ext (mouse-me-buffer-file-extension)))
|
||||
(grep (concat grep-command string
|
||||
(if mouse-me-grep-use-extension
|
||||
(if ext
|
||||
(concat " *" ext)
|
||||
" *"))))))
|
||||
|
||||
(defun mouse-me-find-grep (string)
|
||||
"Grep for a STRING."
|
||||
(interactive "sGrep: ")
|
||||
(grep-compute-defaults)
|
||||
(let ((reg grep-find-command)
|
||||
(ext (mouse-me-buffer-file-extension))
|
||||
beg end)
|
||||
(if (string-match "\\(^.+-type f \\)\\(.+$\\)" reg)
|
||||
(setq reg (concat (match-string 1 reg)
|
||||
(if mouse-me-grep-use-extension
|
||||
(concat "-name \"*" ext "\" "))
|
||||
(match-string 2 reg))))
|
||||
(grep-find (concat reg string))))
|
||||
|
||||
;;;; Internal Functions
|
||||
|
||||
(defun mouse-me-buffer-file-extension ()
|
||||
"Return the extension of the current buffer's filename or nil.
|
||||
Returned extension is a string begining with a period."
|
||||
(let* ((bfn (buffer-file-name))
|
||||
(filename (and bfn (file-name-sans-versions bfn)))
|
||||
(index (and filename (string-match "\\.[^.]*$" filename))))
|
||||
(if index
|
||||
(substring filename index)
|
||||
"")))
|
||||
|
||||
(defun mouse-me-helper (event func)
|
||||
"Determine the string to use to process EVENT and call FUNC to get cmd."
|
||||
(let (name sp sm mouse beg end cmd mmtype)
|
||||
;; temporarily goto where the event occurred, get the name clicked
|
||||
;; on and enough info to figure out what to do with it
|
||||
(save-match-data
|
||||
(save-excursion
|
||||
(setq sp (point)) ; saved point
|
||||
(setq sm (mark t)) ; saved mark
|
||||
(set-buffer (window-buffer (posn-window (event-start event))))
|
||||
(setq mouse (goto-char (posn-point (event-start event))))
|
||||
;; if there is a region and point is inside it
|
||||
;; check for sm first incase (null (mark t))
|
||||
;; set name to either the thing they clicked on or region
|
||||
(if (and sm
|
||||
(or (and transient-mark-mode mark-active)
|
||||
(eq last-command 'mouse-drag-region))
|
||||
(>= mouse (setq beg (min sp sm)))
|
||||
(<= mouse (setq end (max sp sm))))
|
||||
(setq name (buffer-substring beg end))
|
||||
(setq name (funcall mouse-me-get-string-function))
|
||||
(if (listp name)
|
||||
(setq beg (nth 1 name)
|
||||
end (nth 2 name)
|
||||
name (car name))
|
||||
(goto-char mouse)
|
||||
(while (not (looking-at (regexp-quote name)))
|
||||
(backward-char 1))
|
||||
(setq beg (point))
|
||||
(setq end (search-forward name))))))
|
||||
;; check if name is null, meaning they clicked on no word
|
||||
(if (or (null name)
|
||||
(and (stringp name) (string= name "" )))
|
||||
(error "No string to pass to function"))
|
||||
;; popup a menu to get a command to run
|
||||
(setq cmd (funcall func))
|
||||
;; run the command, eval'ing if it was a list
|
||||
(if (listp cmd)
|
||||
(setq cmd (eval cmd)))
|
||||
(setq mmtype (get cmd 'mouse-me-type))
|
||||
(cond ((eq mmtype 'region)
|
||||
(funcall cmd beg end))
|
||||
((eq mmtype 'string)
|
||||
(funcall cmd name))
|
||||
(t
|
||||
(funcall cmd name)))))
|
||||
|
||||
(provide 'mouseme)
|
||||
|
||||
;;; mouseme.el ends here
|
||||
163
lisp/ess/obsolete/msdos.el
Normal file
163
lisp/ess/obsolete/msdos.el
Normal file
@@ -0,0 +1,163 @@
|
||||
;;; msdos.el --- Run an MS-DOS shell in an NTemacs buffer with bash as the shell
|
||||
|
||||
;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
|
||||
;; Author: Richard M. Heiberger <rmh@temple.edu>
|
||||
;; Created: February 1999
|
||||
;; Maintainer: ESS-core <ESS-core@r-project.org>
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;;; License:
|
||||
;;
|
||||
;; This program 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 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
;;
|
||||
;; This program 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.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see
|
||||
;; <http://www.gnu.org/licenses/>
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; The file msdos.el in the next mail message opens an *msdos* buffer
|
||||
;; in shell-mode and msdos-minor-mode. When cmdproxy.exe/command.com
|
||||
;; is the Emacs shell, then this gets various setting right that M-x
|
||||
;; shell currently misses. The function M-x msdos-minor-mode could be
|
||||
;; automatically run by Emacs in shell-mode in that case.
|
||||
|
||||
;; When bash is the Emacs shell, msdos.el still opens a
|
||||
;; cmdproxy.exe/command.com shell in the buffer *msdos*. There are
|
||||
;; occasions when it is necessary to run DOS character-based programs
|
||||
;; in an Emacs window.
|
||||
|
||||
;; I followed the suggestion by AndrewI to look at M-x shell and modify
|
||||
;; it. It turns out not to have been trivial.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'shell); and hence 'comint
|
||||
|
||||
;;; Customization and Buffer Variables
|
||||
|
||||
(defcustom explicit-msdos-shell-file-name "cmdproxy.exe"
|
||||
"*If non-nil, is file name to use for explicitly requested msdos
|
||||
inferior shell."
|
||||
:type '(choice (const :tag "None" nil) file)
|
||||
:group 'shell)
|
||||
|
||||
(defcustom explicit-msdos-comspec-file-name
|
||||
(if (w32-using-nt)
|
||||
"cmd.exe"
|
||||
"command.com")
|
||||
"*If non-nil, is file name to use for explicitly requested COMSPEC
|
||||
environment variable."
|
||||
:type '(choice (const :tag "None" nil) file)
|
||||
:group 'shell)
|
||||
|
||||
(defvar-local msdos-minor-mode nil
|
||||
"Non-nil if using msdos-minor mode as a minor mode of some other mode.")
|
||||
|
||||
(defun msdos ()
|
||||
"Run an inferior msdos shell, with I/O through buffer *msdos*.
|
||||
This function is intended to be used in an Ntemacs session in which
|
||||
bash is the primary shell. But sometimes an MSDOS window, within emacs,
|
||||
is also needed.
|
||||
|
||||
If buffer exists but shell process is not running, make new shell.
|
||||
If buffer exists and shell process is running, just switch to buffer `*msdos*'.
|
||||
Program used comes from variable `explicit-msdos-shell-file-name'.
|
||||
If a file `~/.emacs_SHELLNAME' exists, it is given as initial input
|
||||
(Note that this may lose due to a timing error if the shell
|
||||
discards input when it starts up.)
|
||||
The buffer is put in Shell mode, giving commands for sending input
|
||||
and controlling the subjobs of the shell. See `shell-mode'.
|
||||
See also the variable `shell-prompt-pattern'.
|
||||
|
||||
The buffer is put into \\[msdos-minor-mode]. See `msdos-minor-mode'.
|
||||
|
||||
The COMSPEC environment variable in the inferior shell, but not in the emacs
|
||||
process, is set to `explicit-msdos-comspec-file-name'.
|
||||
The SHELL environment variable in the inferior shell, but not in the emacs
|
||||
process, is set to `explicit-msdos-shell-file-name'.
|
||||
|
||||
The shell file name (sans directories) is used to make a symbol name
|
||||
such as `explicit-csh-args'. If that symbol is a variable,
|
||||
its value is used as a list of arguments when invoking the shell.
|
||||
|
||||
\(Type \\[describe-mode] in the shell buffer for a list of commands.)"
|
||||
(interactive)
|
||||
(if (not (comint-check-proc "*msdos*"))
|
||||
(let* ((prog explicit-msdos-shell-file-name)
|
||||
(name (file-name-nondirectory prog))
|
||||
(startfile (concat "~/.emacs_" name))
|
||||
(xargs-name (intern-soft (concat "explicit-" name "-args")))
|
||||
shell-buffer
|
||||
(comspec (getenv "COMSPEC"))
|
||||
(shell (getenv "SHELL"))
|
||||
)
|
||||
(save-excursion
|
||||
(setenv "COMSPEC" explicit-msdos-comspec-file-name)
|
||||
(setenv "SHELL" explicit-msdos-shell-file-name)
|
||||
(set-buffer (apply 'make-comint "msdos" prog
|
||||
(if (and xargs-name (boundp xargs-name))
|
||||
(symbol-value xargs-name))
|
||||
(if (file-exists-p startfile)
|
||||
(concat "/k " startfile))))
|
||||
(setenv "COMSPEC" comspec)
|
||||
(setenv "SHELL" shell)
|
||||
(setq shell-buffer (current-buffer))
|
||||
(shell-mode)
|
||||
(msdos-minor-mode)
|
||||
(sleep-for 4) ; need to wait, else working too fast!
|
||||
;;; The `exit' warning should precede the "c:\" prompt.
|
||||
;;; If not, then increase the sleep-for time!
|
||||
(goto-char (point-min))
|
||||
(insert
|
||||
"Remember to exit this buffer with `exit'. If you kill the
|
||||
buffer without exiting, you may not be able to shut down Windows cleanly.")
|
||||
(goto-char (point-max)))
|
||||
(pop-to-buffer shell-buffer))
|
||||
(pop-to-buffer "*msdos*")))
|
||||
|
||||
|
||||
(defun msdos-minor-mode ()
|
||||
"Minor mode for running msdos in a shell-mode buffer:
|
||||
a. Uses \\[set-buffer-process-coding-system] to set the coding system
|
||||
to `'raw-text-dos'. The DOS C-m C-l end-of-line is critical. The
|
||||
shell freezes without it.
|
||||
|
||||
b. The variable `comint-completion-addsuffix' is set to `\\' for directories.
|
||||
|
||||
c. Prevents echoing of commands.
|
||||
|
||||
d. strips ctrl-m from output.
|
||||
"
|
||||
(interactive)
|
||||
(setq msdos-minor-mode t)
|
||||
(set (make-local-variable 'comint-completion-addsuffix) '("\\" . " "))
|
||||
(setq comint-process-echoes t)
|
||||
(add-hook 'comint-output-filter-functions 'shell-strip-ctrl-m nil t)
|
||||
(set-process-coding-system (get-buffer-process (current-buffer)) 'raw-text-dos 'raw-text-dos)
|
||||
;; buffer-process-coding-system is critical.
|
||||
)
|
||||
|
||||
;; Install ourselves:
|
||||
|
||||
|
||||
(put 'msdos-minor-mode 'permanent-local t)
|
||||
(or (assq 'msdos-minor-mode minor-mode-alist)
|
||||
(setq minor-mode-alist
|
||||
(append minor-mode-alist
|
||||
(list '(msdos-minor-mode " msdos")))))
|
||||
|
||||
;; Provide ourselves:
|
||||
|
||||
(provide 'msdos)
|
||||
|
||||
;;; msdos.el ends here
|
||||
Reference in New Issue
Block a user