add lisp packages

This commit is contained in:
2020-12-05 21:29:49 +01:00
parent 85e20365ae
commit a6e2395755
7272 changed files with 1363243 additions and 0 deletions

View 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

View 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

View 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

View 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

View 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
View 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