Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
gendl
gendl
Commits
e761fccd
Commit
e761fccd
authored
Mar 03, 2015
by
Dave Cooper
Browse files
Merge branch 'hotfix/glm'
parents
283720bc
de5a7db1
Changes
3
Show whitespace changes
Inline
Side-by-side
emacs/gdl.el
View file @
e761fccd
...
...
@@ -210,6 +210,7 @@
(
defun
load-and-or-start-gendl
()
(
setq
slime-enable-evaluate-in-emacs
t
)
(
slime-repl
)
(
insert
gdl-startup-string
)
(
slime-repl-return
)
...
...
@@ -333,6 +334,28 @@
(
fi:inferior-lisp-newline
)
(
end-of-buffer
)))
(
defun
timestamp
()
(
insert
(
format-time-string
"%Y-%m-%dT%H:%M:%S"
(
current-time
))))
;;
;; See http://pomodorotechnique.com/
;;
(
defun
pomodoro
()
(
timestamp
)
(
insert
(
format-time-string
";%Y-%m-%dT%H:%M:%S;"
(
time-add
(
current-time
)
(
seconds-to-time
(
*
25
60
))))))
(
global-set-key
"\C-t"
'
(
lambda
()
(
interactive
)
(
pomodoro
)))
(
defun
post-pomodoro
()
(
insert
(
format-time-string
"%Y-%m-%dT%H:%M:%S"
(
time-subtract
(
current-time
)
(
seconds-to-time
(
*
25
60
)))))
(
insert
(
format-time-string
";%Y-%m-%dT%H:%M:%S;"
(
current-time
))))
(
global-set-key
"\M-t"
'
(
lambda
()
(
interactive
)
(
post-pomodoro
)))
;;
;; Establish input method for I.A.S.T diacritics
;;
...
...
patches/1588/p005.lisp
0 → 100644
View file @
e761fccd
(
in-package
:surf
)
(
defparameter
*1588p005-doc*
" Fix the order of the returned u,v point for the point function of uv-iso-curve."
)
(
define-object
uv-iso-curve
()
:documentation
(
:description
"Convenience object to return UV parameter values on surface."
)
:input-slots
(
surface
parameter
u-or-v
)
:functions
((
"2D point. The UV surface representation at the given parameter value.
:arguments (parameter \"Number. The parameter value you want.\")"
point
(
parameter
)
(
ecase
(
the
u-or-v
)
(
:v
(
make-point
(
the
parameter
)
parameter
))
(
:u
(
make-point
parameter
(
the
parameter
)))))))
patches/1588/p006.lisp
0 → 100644
View file @
e761fccd
(
in-package
:gdl
)
(
defparameter
*1588p006-doc*
" Keep the items in internal %version-tree% sorted based on root-path length."
)
(
define-object-amendment
vanilla-mixin*
()
:functions
((
"NIL. Restores the value of the given slot to its default, thus ``undoing'' any forcibly set value
in the slot. Any dependent slots in the tree will respond accordingly when they are next demanded.
Note that the slot must be specified as a keyword symbol (i.e. prepended with a colon (``:'')),
otherwise it will be evaluated as a variable according to normal Lisp functional evaluation rules.
:arguments (slot \"Keyword Symbol\")
:key (force? \"Boolean. Specify as t if you want to force non-settable slots to recompute (e.g.
reading from databases or external files). Defaults to nil.\")"
restore-slot-default!
(
attribute
&key
(
force?
*force-restore-slot-default?*
))
(
when
(
or
force?
(
eql
(
the
(
slot-status
attribute
))
:set
))
(
let
(
*leaf-resets*
)
(
let
((
slot
(
glisp:intern
(
symbol-name
attribute
)
:gdl-acc
)))
(
unless
(
eq
(
first
(
ensure-list
(
slot-value
self
slot
)))
'gdl-rule::%unbound%
)
(
unbind-dependent-slots
self
slot
)
(
setf
(
slot-value
self
slot
)
(
if
*remember-previous-slot-values?*
(
list
'gdl-rule::%unbound%
nil
nil
(
first
(
slot-value
self
slot
)))
'gdl-rule::%unbound%
))))
(
let
((
root
(
let
((
maybe-root
(
the
:root
)))
(
if
(
the-object
maybe-root
root?
)
maybe-root
(
the-object
maybe-root
parent
))))
;;(root-path (remove :root-object-object (the root-path)))
(
root-path
(
the
root-path
))
)
;;
;; FLAG -- this pushnew should never be necessary...
;;
(
pushnew
(
list
root-path
)
(
gdl-acc::%version-tree%
root
)
:test
#'
equalp
:key
#'
(
lambda
(
item
)
(
list
(
first
item
))))
(
setf
(
rest
(
assoc
root-path
(
gdl-acc::%version-tree%
root
)
:test
#'
equalp
))
(
remove-plist-key
(
rest
(
assoc
root-path
(
gdl-acc::%version-tree%
root
)
:test
#'
equalp
))
attribute
))
(
setf
(
gdl-acc::%version-tree%
root
)
(
sort
(
gdl-acc::%version-tree%
root
)
#'
(
lambda
(
item1
item2
)
(
<
(
length
(
first
item1
))
(
length
(
first
item2
)))))))
(
when
*eager-setting-enabled?*
(
dolist
(
reset
*leaf-resets*
)
(
the-object
(
first
reset
)
(
evaluate
(
second
reset
))))))))
(
"Void. Writes a file containing the toplevel inputs and modified settable-slots starting from the root of the
current instance. Typically this file can be read back into the system using the <tt>read-snapshot</tt> function.
:&key ((filename \"/tmp/snap.gdl\") \"String or pathname. The target file to be written.\"
(root-paths-to-ignore nil) \"List of root-paths or nil. Any objects with matching root-path will be ignored for the snapshot write.\"
)"
write-snapshot
(
&key
(
filename
"/tmp/snap.gdl"
)
(
root-paths-to-ignore
nil
))
(
let
(
*print-level*
(
root-object-object?
(
and
(
the
parent
)
(
the
parent
root?
)
(
defaulting
(
the
parent
root-object-object
))
(
eql
(
the
parent
root-object-object
)
self
))))
(
let
((
root
(
if
root-object-object?
(
the
root
parent
)
(
the
root
))))
(
setf
(
gdl-acc::%version-tree%
root
)
(
sort
(
gdl-acc::%version-tree%
root
)
#'
(
lambda
(
item1
item2
)
(
<
(
length
(
first
item1
))
(
length
(
first
item2
))))))
(
with-open-file
(
out
filename
:direction
:output
:if-exists
:supersede
:if-does-not-exist
:create
)
(
print
`
(
in-package
,
(
make-keyword
(
package-name
*package*
)))
out
)
(
mapcar
#'
(
lambda
(
node
)
(
let
((
root-path
(
first
node
))
(
value-plist
(
rest
node
)))
(
unless
(
or
(
member
root-path
root-paths-to-ignore
:test
#'
equalp
)
(
and
root-object-object?
(
not
(
eql
(
lastcar
root-path
)
:root-object-object
))))
(
when
root-object-object?
(
setq
root-path
(
if
(
consp
(
rest
root-path
))
(
butlast
root-path
)
(
the
type
))))
(
let
((
keys
(
plist-keys
value-plist
))
(
values
(
plist-values
value-plist
)))
(
let
((
snap
(
cons
root-path
(
append
(
when
(
atom
root-path
)
(
let
(
result
)
(
let*
((
toplevel-inputs
(
remove-plist-key
(
the
root
active-inputs
)
:remote-id
))
(
toplevel-input-keys
(
plist-keys
toplevel-inputs
))
(
toplevel-input-values
(
plist-values
toplevel-inputs
)))
(
mapc
#'
(
lambda
(
key
value
)
(
when
(
not
(
member
key
keys
))
(
push
key
result
)
(
push
value
result
)))
toplevel-input-keys
toplevel-input-values
))
(
nreverse
result
)))
(
mapcan
#'
(
lambda
(
key
val
)
(
let
((
expression
(
readable-expression
val
self
)))
(
unless
(
eql
expression
:%unreadable%
)
(
list
key
expression
))))
keys
values
)))))
(
print
snap
out
))))))
(
or
(
gdl-acc::%version-tree%
root
)
(
list
nil
))))))
filename
)))
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment