Reorganization of examples: delete references to J.

parent 3ea5a560
;;; complete.lisp
;;;
;;; Copyright (C) 2004 Peter Graves
;;; $Id: complete.lisp,v 1.2 2004-09-05 00:12:25 piso Exp $
;;;
;;; 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 2
;;; 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, write to the Free Software
;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
(in-package "J")
(export 'complete)
(defvar *prefix* nil)
(defvar *completions* ())
(defvar *completion-index* 0)
(defun compound-prefix-match (prefix target)
(let ((tlen (length target))
(tpos 0))
(dotimes (i (length prefix))
(when (>= tpos tlen)
(return-from compound-prefix-match nil))
(let ((ch (schar prefix i)))
(if (char= ch #\-)
(unless (setf tpos (position #\- target :start tpos))
(return-from compound-prefix-match nil))
(unless (char-equal ch (schar target tpos))
(return-from compound-prefix-match nil)))
(incf tpos)))
t))
(defun completion-set (prefix)
(let ((result ()))
(do-external-symbols (symbol "CL")
(let ((name (symbol-name symbol)))
(when (compound-prefix-match prefix name)
(push symbol result))))
result))
(defun completion-prefix ()
(let* ((string (line-chars (current-line)))
(end (mark-charpos (current-point))))
(do ((start (1- end) (1- start)))
((< start 0) (subseq string 0 end))
(let ((ch (schar string start)))
(when (or (eql ch #\space) (eql ch #\())
(incf start)
(return-from completion-prefix (subseq string start end)))))))
(defun complete ()
(cond ((eq *last-command* 'complete)
(unless (> (length *completions*) 1)
(return-from complete))
(undo)
(incf *completion-index*)
(when (> *completion-index* (1- (length *completions*)))
(setf *completion-index* 0)))
(t
(setf *prefix* (completion-prefix)
*completions* nil
*completion-index* 0)
(when *prefix*
(setf *completions* (completion-set *prefix*)))))
(when *completions*
(let ((completion (string-downcase (nth *completion-index* *completions*)))
(point (current-point)))
(with-single-undo
(goto-char (make-mark (mark-line point)
(- (mark-charpos point) (length *prefix*))))
(set-mark point)
(delete-region)
(insert completion)))
(setf *current-command* 'complete))
(values))
(map-key-for-mode "Ctrl Space" "(complete)" "Lisp")
(map-key-for-mode "Ctrl Space" "(complete)" "Lisp Shell")
;;; init.lisp
;;; $Id: init.lisp,v 1.36 2007-03-04 19:08:11 piso Exp $
;;; ~/.j/init.lisp (if it exists) is loaded automatically when j starts up.
(defun java-version ()
(jstatic "getProperty" "java.lang.System" "java.version"))
(defun adjust-appearance ()
(when (member (subseq (java-version) 0 5)
'("1.4.0" "1.4.1" "1.4.2" "1.5.0" "1.6.0" "1.7.0")
:test #'string=)
(set-global-property "adjustAscent" -2)
(set-global-property "adjustLeading" -2)
(reset-display)))
;; Do it now!
(adjust-appearance)
;; Turn off the remove-trailing-whitespace preference for files in the
;; directory ~/gcl/ansi-tests.
(defun my-open-file-hook (buf)
(let ((pathname (buffer-pathname buf)))
(when (and pathname
(string= (directory-namestring pathname)
"/home/peter/gcl/ansi-tests/"))
(set-buffer-property "removeTrailingWhitespace" nil))))
(add-hook 'open-file-hook 'my-open-file-hook)
;; Helper function for MY-BUFFER-ACTIVATED-HOOK.
(defun sub-p (namestring dirname)
"Returns T if NAMESTRING is in DIRNAME or one of its subdirectories"
(let ((dirname-length (length dirname)))
(and (> (length namestring) dirname-length)
(string= (subseq namestring 0 dirname-length) dirname))))
(defun my-buffer-activated-hook (buf)
(let ((pathname (buffer-pathname buf)))
;; PATHNAME might be NIL (not all buffers have associated files).
(when pathname
(let ((type (pathname-type pathname)))
;; We only care about Lisp and Java buffers.
(cond ((string= type "el")
(set-buffer-property
"tagPath"
"/home/peter/emacs-21.3/lisp:/home/peter/emacs-21.3/lisp/emacs-lisp"))
((member type '("lisp" "lsp" "cl" "java") :test 'string=)
(let* ((namestring (namestring pathname))
(tagpath
(cond ((sub-p namestring "/home/peter/cmucl/src/")
"/home/peter/cmucl/src/code:/home/peter/cmucl/src/compiler:/home/peter/cmucl/src/pcl")
((sub-p namestring "/home/peter/cl-bench/")
"/home/peter/cl-bench:/home/peter/cl-bench/files:/home/peter/depot/j/src/org/armedbear/lisp")
((sub-p namestring "/home/peter/gcl/ansi-tests/")
"/home/peter/gcl/ansi-tests:/home/peter/depot/j/src/org/armedbear/lisp")
((sub-p namestring "/home/peter/phemlock")
"/home/peter/phemlock/src/core:/home/peter/phemlock/src/user")
((sub-p namestring "/home/peter/sbcl")
"/home/peter/sbcl/src/code:/home/peter/sbcl/src/compiler")
(t ; default case: no change
nil))))
;; If we end up here with a non-NIL TAGPATH, use it to set the
;; buffer-specific value of the TAG-PATH preference for the current
;; buffer.
(when tagpath
(set-buffer-property "tagPath" tagpath)))))))))
;; Install our hook function.
(add-hook 'buffer-activated-hook 'my-buffer-activated-hook)
;; Call ADJUST-APPEARANCE after saving ~/.j/prefs.
(defun my-after-save-hook (buf)
(let ((pathname (buffer-pathname buf)))
(when (equal pathname #p"/home/peter/.j/prefs")
(adjust-appearance))))
(add-hook 'after-save-hook 'my-after-save-hook)
(defun reset-incoming-filters ()
(jstatic "resetIncomingFilters" "org.armedbear.j.mail.IncomingFilter"))
(defun add-incoming-filter (mailbox pattern action parameter)
(jstatic "addIncomingFilter" "org.armedbear.j.mail.IncomingFilter"
mailbox pattern action parameter))
(add-hook 'mailbox-mode-hook
(lambda ()
(reset-incoming-filters)
(add-incoming-filter "inbox"
"~C linux-kernel"
"move"
"mail/linux-kernel")
(add-incoming-filter "inbox"
"~C ix.netcom.com"
"move"
"mail/netcom")))
(defun maybe-load (pathname)
(when (probe-file pathname)
(load pathname)))
(maybe-load "/home/peter/.j/key-pressed.lisp")
(maybe-load "/home/peter/.j/update-check-enabled.lisp")
(maybe-load #+windows "c:/cygwin/home/peter/j/build-abcl.lisp"
#-windows "/home/peter/j/build-abcl.lisp")
(map-key-for-mode ")" "electricCloseParen" "Lisp Shell")
(map-key-for-mode "[" "insertParentheses" "Lisp")
(map-key-for-mode "]" "movePastCloseAndReindent" "Lisp")
;;; key-pressed.lisp
;;;
;;; Copyright (C) 2003-2005 Peter Graves
;;; $Id: key-pressed.lisp,v 1.8 2005-11-18 01:47:25 piso Exp $
;;;
;;; 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 2
;;; 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, write to the Free Software
;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
(unless (find-package "KEY-PRESSED")
(make-package "KEY-PRESSED" :nicknames '("KP") :use '("CL" "J")))
(in-package "KEY-PRESSED")
;; No exports.
(defcommand open-file)
(defcommand open-file-in-other-window)
(defcommand open-file-in-other-frame)
;; (defcommand new-buffer)
(defcommand recent-files)
(defcommand save)
(defcommand save-as)
(defcommand save-copy)
(defcommand save-all)
(defcommand kill-buffer)
(defcommand properties)
(defcommand next-buffer)
(defcommand prev-buffer)
(defcommand new-frame)
;; (defcommand execute-command "executeCommand")
;; (defcommand j-print "print")
(defcommand save-all-exit)
(defcommand quit)
(defcommand jump-to-line)
(defcommand jump-to-column)
(defcommand j-find "find")
(defcommand incremental-find)
(defcommand list-occurrences)
(defcommand find-in-files)
(defcommand list-files)
(defcommand sidebar-list-tags)
(defcommand j-replace "replace")
(defcommand replace-in-files)
(defcommand dir)
(defcommand goto-bookmark)
(defcommand help)
(defcommand describe-key)
(defcommand next-frame)
(defcommand select-word)
(defcommand kill-frame)
(defcommand toggle-sidebar)
(defcommand sidebar-list-buffers)
(defcommand split-window)
(defcommand unsplit-window)
(defcommand other-window)
(defcommand shell)
;;; Incremental find needs special handling.
(defun invoke-incremental-find ()
(location-bar-cancel-input)
(restore-focus)
(invoke-later 'incremental-find))
(defvar *table* (make-hash-table :test #'equalp))
;;; Object can be a symbol or a function.
(defun assign-key (key object)
(setf (gethash key *table*) object))
;;; The hook function.
(defun key-pressed (&rest args)
(let* ((key (car args))
(value (gethash key *table*)))
(when (and value
(or (functionp value)
(and (symbolp value) (fboundp value))))
(funcall value))))
;;; Key assignments.
(assign-key "Ctrl O"
#'(lambda ()
(location-bar-cancel-input)
(update-location-bar)
(open-file)))
(assign-key "Ctrl Alt O"
#'(lambda () (open-file-in-other-window) (update-location-bar)))
(assign-key "Ctrl Shift O" 'open-file-in-other-frame)
;; Ctrl N is used for history in textfields.
;; (assign-key "Ctrl N" 'new-buffer)
(assign-key "Alt R" 'recent-files)
(assign-key "Ctrl S" 'save)
(assign-key "Ctrl Shift S" 'save-as)
(assign-key "Ctrl Alt S" 'save-copy)
(assign-key "F2" 'save-all)
(assign-key "Ctrl F4" 'kill-buffer)
(assign-key "Ctrl W" 'kill-buffer)
(assign-key "Alt P" 'properties)
(assign-key "Alt NumPad Right"
#'(lambda () (restore-focus) (next-buffer)))
(assign-key "Alt Right"
#'(lambda () (restore-focus) (next-buffer)))
(assign-key "Alt NumPad Left"
#'(lambda () (restore-focus) (prev-buffer)))
(assign-key "Alt Left"
#'(lambda () (restore-focus) (prev-buffer)))
(assign-key "Ctrl Shift N" 'new-frame)
(assign-key "Alt X" 'execute-command)
;; Ctrl P is used for history in textfields.
;; (assign-key "Ctrl P" 'j-print)
(assign-key "Ctrl Shift Q" 'save-all-exit)
(assign-key "Ctrl Q" 'quit)
(assign-key "Ctrl J" 'jump-to-line)
(assign-key "Ctrl Shift J" 'jump-to-column)
(assign-key "Alt F3"
#'(lambda () (location-bar-cancel-input) (restore-focus) (j-find)))
(assign-key "Ctrl F" 'invoke-incremental-find)
(assign-key "Alt L" 'list-occurrences)
(assign-key "F6" 'find-in-files)
(assign-key "Ctrl Shift F" 'find-in-files)
(assign-key "Ctrl L" 'list-files)
(assign-key "Ctrl Shift L" 'sidebar-list-tags)
(assign-key "Ctrl R" 'j-replace)
(assign-key "Ctrl Shift R" 'replace-in-files)
(assign-key "Ctrl D" 'dir)
(assign-key "Ctrl 0" 'goto-bookmark)
(assign-key "Ctrl 1" 'goto-bookmark)
(assign-key "Ctrl 2" 'goto-bookmark)
(assign-key "Ctrl 3" 'goto-bookmark)
(assign-key "Ctrl 4" 'goto-bookmark)
(assign-key "Ctrl 5" 'goto-bookmark)
(assign-key "Ctrl 6" 'goto-bookmark)
(assign-key "Ctrl 7" 'goto-bookmark)
(assign-key "Ctrl 8" 'goto-bookmark)
(assign-key "Ctrl 9" 'goto-bookmark)
(assign-key "F1" 'help)
(assign-key "Alt K" 'describe-key)
(assign-key "Alt N" 'next-frame)
(assign-key "Alt W" 'select-word)
(assign-key "Ctrl Shift W" 'kill-frame)
(assign-key "Alt =" 'toggle-sidebar)
(assign-key "Alt B" 'sidebar-list-buffers)
(assign-key "F10" 'split-window)
(assign-key "Shift F10" 'unsplit-window)
(assign-key "Alt O" 'other-window)
(assign-key "Alt F9"
#'(lambda () (restore-focus) (shell)))
;;; Enable the hook.
(add-hook 'key-pressed-hook 'key-pressed)
(set-global-property "enableKeyPressedHook" t)
;; NOTE: ENABLE-KEY-PRESSED-HOOK will be reset to its default value (NIL) when
;; preferences are reloaded (which happens automatically when you edit your
;; preferences file). To prevent this (and keep the key-pressed hook working
;; properly across preference file edits), add this line to ~/.j/prefs:
;;
;; enableKeyPressedHook = true
;;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment