Commit 1607c151 authored by David O'Toole's avatar David O'Toole

xelf lisp update

parent a82a245b
......@@ -112,7 +112,7 @@
(make-pathname :name (concatenate 'string (clean-name name) ".org")
:defaults (cl-fad:pathname-as-directory directory)))
(defun make-dictionary (package-name directory)
(defun make-dictionary (package-name directory &optional buffer)
(let ((package (find-package package-name))
(symbols nil)
(*symbol-count* 0))
......
......@@ -39,12 +39,12 @@
)
"(%%inputs self '\\1)"))
(defun checkdoc-next-block ()
(interactive)
(search-forward "#begin_src lisp" nil t)
(forward-line)
(beginning-of-line)
(org-edit-special)
(checkdoc))
;; (defun checkdoc-next-block ()
;; (interactive)
;; (when (search-forward "#+begin_src lisp" nil t)
;; (forward-line)
;; (beginning-of-line)
;; (org-edit-special)
;; (let (buffer-file-name)
;; (checkdoc-defun t)
This diff is collapsed.
......@@ -1050,7 +1050,7 @@ Returns a newly allocated list."
(setf *buffer* buffer)
(setf *blocks* (list buffer))
(when *clear-cached-fonts-on-buffer-switch*
(clear-font-caches)))
(clear-cached-fonts)))
(defmacro with-buffer (buffer &rest body)
"Evaluate the BODY forms in the given BUFFER."
......@@ -2397,7 +2397,7 @@ Returns a newly allocated list."
(when (numberp pos)
(subseq name (1+ pos)))))
(defun native-namestring (name) #+ecl (namestring name)
(defun find-native-namestring (name) #+ecl (namestring name)
#+ccl (ccl:native-translated-namestring name)
#+sbcl (sb-ext:native-namestring name))
......@@ -2509,7 +2509,7 @@ Returns a newly allocated list."
(defun add-file-resource (filename)
(add-resource (expand-resource-description
(list :name (native-namestring (file-namestring filename))))))
(list :name (find-native-namestring (file-namestring filename))))))
(defun index-all-samples ()
"Index all .WAV samples in the project."
......@@ -2643,11 +2643,11 @@ Returns a newly allocated list."
(defun find-directories (dir)
(mapcar #'(lambda (s)
(subseq s 0 (1- (length s))))
(mapcar #'native-namestring
(mapcar #'find-native-namestring
(directory (concatenate 'string (namestring dir) "/*/")))))
(defun directory-files (dir)
(sort (mapcar #'native-namestring
(sort (mapcar #'find-native-namestring
(directory (concatenate 'string (namestring dir) "/*/")))
#'string<))
......@@ -2895,7 +2895,7 @@ Returns a newly allocated list."
;; and skip loading from file
(resource-object resource)
;; image to be loaded from file. load it
(sdl-image:load-image (native-namestring (resource-file resource))
(sdl-image:load-image (find-native-namestring (resource-file resource))
:alpha 255))))
(prog1 surface
(when surface
......@@ -2964,7 +2964,7 @@ Returns a newly allocated list."
(make-database-resource database)
(message "Saving ~S objects from database into ~A..."
count
(native-namestring file))
(find-native-namestring file))
(save-resource-file file (list resource))
(message "Finished saving database into ~A. Continuing..." file))))
......@@ -3029,17 +3029,17 @@ Returns a newly allocated list."
(defun load-ttf-resource (resource)
(let* ((size (getf (resource-properties resource) :size))
(definition (make-instance 'sdl:ttf-font-definition
:filename (native-namestring (resource-file resource))
:filename (find-native-namestring (resource-file resource))
:size (* *font-texture-scale* size))))
(sdl:initialise-font definition)))
(defun load-music-resource (resource)
(when *use-sound*
(sdl-mixer:load-music (native-namestring (resource-file resource)))))
(sdl-mixer:load-music (find-native-namestring (resource-file resource)))))
(defun load-sample-resource (resource)
(when *use-sound*
(let ((chunk (sdl-mixer:load-sample (native-namestring (resource-file resource)))))
(let ((chunk (sdl-mixer:load-sample (find-native-namestring (resource-file resource)))))
(prog1 chunk
(when (resource-properties resource)
(destructuring-bind (&key volume) (resource-properties resource)
......@@ -3190,7 +3190,7 @@ Returns a newly allocated list."
(when (member (resource-type resource) *file-resource-types*)
(setf (resource-file resource)
(make-pathname
:name (native-namestring
:name (find-native-namestring
(or (resource-file resource)
(resource-name resource)))
:defaults (find-project-path *project*)
......@@ -3989,7 +3989,7 @@ Returns a newly allocated list."
(gl:finish)
(sdl:update-display)))))))
(defun quit (&optional shutdown)
(defun quit-xelf (&optional shutdown)
"Exit the game engine."
(when shutdown
(setf *quitting* t))
......
#+TITLE: Xelf: eXtensible Emacs-Like Facility
#+AUTHOR: David O'Toole <dto@xelf.me>
#+OPTIONS: toc:3 *:nil
#+PROPERTY: header-args:lisp :results silent :noweb no :tangle xelf.lisp
#+PROPERTY: header-args:lisp :results silent :noweb no :tangle xelf.lisp :package "xelf"
#+INFOJS_OPT: view:info mouse:underline up:index.html home:http://xelf.me toc:t ftoc:t ltoc:t
# (setq org-confirm-babel-evaluate nil)
......@@ -241,12 +241,12 @@ related definitions.
** Org-babel patch
This patch is required to fix a bug in Org Babel's source block
editing in Lisp mode.
This patch is required to work around a bug in Org Babel's source
block editing in Lisp mode.
#+begin_src emacs-lisp :tangle no
diff -u /home/dto/.emacs.d/elpa/org-20170210/org-src.el\~ /home/dto/.emacs.d/elpa/org-20170210/org-src.el
--- /home/dto/.emacs.d/elpa/org-20170210/org-src.el~ 2017-03-30 21:19:03.843491158 -0400
#+begin_example
diff -u /home/dto/.emacs.d/elpa/org-20170210/org-src.el /home/dto/.emacs.d/elpa/org-20170210/org-src.el
--- /home/dto/.emacs.d/elpa/org-20170210/org-src.original.el 2017-03-30 21:19:03.843491158 -0400
+++ /home/dto/.emacs.d/elpa/org-20170210/org-src.el 2017-04-07 08:57:58.423774223 -0400
@@ -394,7 +394,7 @@
(with-temp-buffer
......@@ -259,7 +259,7 @@ diff -u /home/dto/.emacs.d/elpa/org-20170210/org-src.el\~ /home/dto/.emacs.d/elp
(goto-char (point-min))
Diff finished. Fri Apr 7 08:59:33 2017
#+end_src
#+end_example
** Emacs Lisp compatibility macro :emacs:
......@@ -1521,7 +1521,7 @@ Only one buffer can be active at a time.
(setf *buffer* buffer)
(setf *blocks* (list buffer))
(when *clear-cached-fonts-on-buffer-switch*
(clear-font-caches)))
(clear-cached-fonts)))
(defmacro with-buffer (buffer &rest body)
"Evaluate the BODY forms in the given BUFFER."
......@@ -3128,7 +3128,7 @@ increases.
** Finding the native path string :sbcl:ccl:ecl:
#+begin_src lisp
(defun native-namestring (name) #+ecl (namestring name)
(defun find-native-namestring (name) #+ecl (namestring name)
,#+ccl (ccl:native-translated-namestring name)
,#+sbcl (sb-ext:native-namestring name))
#+end_src
......@@ -3253,7 +3253,7 @@ increases.
(defun add-file-resource (filename)
(add-resource (expand-resource-description
(list :name (native-namestring (file-namestring filename))))))
(list :name (find-native-namestring (file-namestring filename))))))
(defun index-all-samples ()
"Index all .WAV samples in the project."
......@@ -3387,11 +3387,11 @@ increases.
(defun find-directories (dir)
(mapcar #'(lambda (s)
(subseq s 0 (1- (length s))))
(mapcar #'native-namestring
(mapcar #'find-native-namestring
(directory (concatenate 'string (namestring dir) "/*/")))))
(defun directory-files (dir)
(sort (mapcar #'native-namestring
(sort (mapcar #'find-native-namestring
(directory (concatenate 'string (namestring dir) "/*/")))
#'string<))
......@@ -3651,7 +3651,7 @@ increases.
;; and skip loading from file
(resource-object resource)
;; image to be loaded from file. load it
(sdl-image:load-image (native-namestring (resource-file resource))
(sdl-image:load-image (find-native-namestring (resource-file resource))
:alpha 255))))
(prog1 surface
(when surface
......@@ -3728,7 +3728,7 @@ increases.
(make-database-resource database)
(message "Saving ~S objects from database into ~A..."
count
(native-namestring file))
(find-native-namestring file))
(save-resource-file file (list resource))
(message "Finished saving database into ~A. Continuing..." file))))
......@@ -3797,17 +3797,17 @@ increases.
(defun load-ttf-resource (resource)
(let* ((size (getf (resource-properties resource) :size))
(definition (make-instance 'sdl:ttf-font-definition
:filename (native-namestring (resource-file resource))
:filename (find-native-namestring (resource-file resource))
:size (* *font-texture-scale* size))))
(sdl:initialise-font definition)))
(defun load-music-resource (resource)
(when *use-sound*
(sdl-mixer:load-music (native-namestring (resource-file resource)))))
(sdl-mixer:load-music (find-native-namestring (resource-file resource)))))
(defun load-sample-resource (resource)
(when *use-sound*
(let ((chunk (sdl-mixer:load-sample (native-namestring (resource-file resource)))))
(let ((chunk (sdl-mixer:load-sample (find-native-namestring (resource-file resource)))))
(prog1 chunk
(when (resource-properties resource)
(destructuring-bind (&key volume) (resource-properties resource)
......@@ -3969,7 +3969,7 @@ increases.
(when (member (resource-type resource) *file-resource-types*)
(setf (resource-file resource)
(make-pathname
:name (native-namestring
:name (find-native-namestring
(or (resource-file resource)
(resource-name resource)))
:defaults (find-project-path *project*)
......@@ -4833,7 +4833,7 @@ This section needs to be cleaned up.
* TODO Session startup/shutdown
#+begin_src lisp
(defun quit (&optional shutdown)
(defun quit-xelf (&optional shutdown)
"Exit the game engine."
(when shutdown
(setf *quitting* t))
......@@ -10473,17 +10473,9 @@ hybrid GUI inspired by MIT Scratch and its derivatives.
#+end_src
* Task list
** DONE Re-enable mouse ops
CLOSED: [2017-04-06 Thu 20:51]
** TODO re-watch Lightning talk videos and take notes
** TODO Field for enabling mouse ops in buffer
** TODO Re-test command prompt
** TODO re-test gui
** TODO re-watch Lightning talk videos and take notes
** TODO [#B] Document how to clear all caches
** TODO [#C] Automate doc build
** DONE Compile revised GUI code
CLOSED: [2017-04-06 Thu 20:15]
** DONE Import remaining GUI code
CLOSED: [2017-04-06 Thu 20:15]
** DONE check for defmethod initialize without -instance
CLOSED: [2017-04-06 Thu 20:14]
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