procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Replace nested ifs with cond

Browse source 
* lisp/play/dunnet.el (dun-messages, dun-describe-room, dun-examine):
(dun-eat, dun-put-objs, dun-turn, dun-press, dun-ls, dun-cd): Use when
and cond where appropriate.
(dun-sauna-heat): Accept sauna level as an argument.  Use cond.
(dun-take): Use null and dun-mprincl.
(dun-inven-weight, dun-load-d): Reformat.
(dun-remove-obj-from-inven, dun-remove-obj-from-room): Nix setq to nil.
This commit is contained in:
Mark Oteiza 2017-02-19 21:31:22 -05:00
parent c8d14cfc6c
commit 0db5ba48b2
1 changed files with 249 additions and 297 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

334
lisp/play/dunnet.el
View file

@ -1154,14 +1154,12 @@ treasures for points?" "4" "four")
(defun dun-messages () (defun dun-messages ()
(if dun-dead (if dun-dead
(text-mode) (text-mode)
(if (eq dungeon-mode 'dungeon) (when (eq dungeon-mode 'dungeon)
(progn (when (not (= room dun-current-room))
(if (not (= room dun-current-room))
(progn
(dun-describe-room dun-current-room) (dun-describe-room dun-current-room)
(setq room dun-current-room))) (setq room dun-current-room))
(dun-fix-screen) (dun-fix-screen)
(dun-mprinc ">"))))) (dun-mprinc ">"))))
;;;###autoload ;;;###autoload
@ -1193,23 +1191,22 @@ treasures for points?" "4" "four")
nil nil
(dun-mprinc (car (nth (abs room) dun-rooms))) (dun-mprinc (car (nth (abs room) dun-rooms)))
(dun-mprinc "\n")) (dun-mprinc "\n"))
(if (not (string= dun-mode "long")) (when (and (not (string= dun-mode "long"))
(if (not (member (abs room) dun-visited)) (not (member (abs room) dun-visited)))
(setq dun-visited (append (list (abs room)) dun-visited)))) (setq dun-visited (append (list (abs room)) dun-visited)))
(dolist (xobjs (nth dun-current-room dun-room-objects)) (dolist (xobjs (nth dun-current-room dun-room-objects))
(if (= xobjs obj-special) (cond
(dun-special-object) ((= xobjs obj-special)
(if (>= xobjs 0) (dun-special-object))
(dun-mprincl (car (nth xobjs dun-objects))) ((>= xobjs 0)
(if (not (and (= xobjs obj-bus) dun-inbus)) (dun-mprincl (car (nth xobjs dun-objects))))
(progn ((not (and (= xobjs obj-bus) dun-inbus))
(dun-mprincl (car (nth (abs xobjs) dun-perm-objects))))))) (dun-mprincl (car (nth (abs xobjs) dun-perm-objects)))))
(if (and (= xobjs obj-jar) dun-jar) (when (and (= xobjs obj-jar) dun-jar)
(progn
(dun-mprincl "The jar contains:") (dun-mprincl "The jar contains:")
(dolist (x dun-jar) (dolist (x dun-jar)
(dun-mprinc " ") (dun-mprinc " ")
(dun-mprincl (car (nth x dun-objects))))))) (dun-mprincl (car (nth x dun-objects))))))
(if (and (member obj-bus (nth dun-current-room dun-room-objects)) dun-inbus) (if (and (member obj-bus (nth dun-current-room dun-room-objects)) dun-inbus)
(dun-mprincl "You are on the bus.")))) (dun-mprincl "You are on the bus."))))
@ -1314,35 +1311,31 @@ disk bursts into flames, and disintegrates.")
(dun-mprincl (cadr (nth x dun-objects)))))))))) (dun-mprincl (cadr (nth x dun-objects))))))))))
(defun dun-shake (obj) (defun dun-shake (obj)
(let (objnum) (let ((objnum (dun-objnum-from-args-std obj)))
(when (setq objnum (dun-objnum-from-args-std obj)) (when objnum
(if (member objnum dun-inventory) (cond
(progn ((member objnum dun-inventory)
;;; If shaking anything will do anything, put here. ;; If shaking anything will do anything, put here.
(dun-mprinc "Shaking ") (dun-mprinc "Shaking ")
(dun-mprinc (downcase (cadr (nth objnum dun-objects)))) (dun-mprinc (downcase (cadr (nth objnum dun-objects))))
(dun-mprinc " seems to have no effect.") (dun-mprinc " seems to have no effect.")
(dun-mprinc "\n") (dun-mprinc "\n"))
) ((and (not (member objnum (nth dun-current-room dun-room-silents)))
(if (and (not (member objnum (nth dun-current-room dun-room-silents)))
(not (member objnum (nth dun-current-room dun-room-objects)))) (not (member objnum (nth dun-current-room dun-room-objects))))
(dun-mprincl "I don't see that here.") (dun-mprincl "I don't see that here."))
;;; Shaking trees can be deadly ;; Shaking trees can be deadly
(if (= objnum obj-tree) ((= objnum obj-tree)
(progn
(dun-mprinc (dun-mprinc
"You begin to shake a tree, and notice a coconut begin to fall from the air. "You begin to shake a tree, and notice a coconut begin to fall from the air.
As you try to get your hand up to block it, you feel the impact as it lands As you try to get your hand up to block it, you feel the impact as it lands
on your head.") on your head.")
(dun-die "a coconut")) (dun-die "a coconut"))
(if (= objnum obj-bear) ((= objnum obj-bear)
(progn
(dun-mprinc (dun-mprinc
"As you go up to the bear, it removes your head and places it on the ground.") "As you go up to the bear, it removes your head and places it on the ground.")
(dun-die "a bear")) (dun-die "a bear"))
(if (< objnum 0) ((< objnum 0) (dun-mprincl "You cannot shake that."))
(dun-mprincl "You cannot shake that.") (t (dun-mprincl "You don't have that."))))))
(dun-mprincl "You don't have that.")))))))))
(defun dun-drop (obj) (defun dun-drop (obj)
@ -1396,24 +1389,22 @@ through.")))))
;;; Give long description of current room, or an object. ;;; Give long description of current room, or an object.
(defun dun-examine (obj) (defun dun-examine (obj)
(let (objnum) (let ((objnum (dun-objnum-from-args obj)))
(setq objnum (dun-objnum-from-args obj)) (cond
(if (eq objnum obj-special) ((eq objnum obj-special)
(dun-describe-room (* dun-current-room -1)) (dun-describe-room (* dun-current-room -1)))
(if (and (eq objnum obj-computer) ((and (eq objnum obj-computer)
(member obj-pc (nth dun-current-room dun-room-silents))) (member obj-pc (nth dun-current-room dun-room-silents)))
(dun-examine '("pc")) (dun-examine '("pc")))
(if (eq objnum nil) ((null objnum)
(dun-mprincl "I don't know what that is.") (dun-mprincl "I don't know what that is."))
(if (and (not (member objnum ((and (not (member objnum (nth dun-current-room dun-room-objects)))
(nth dun-current-room dun-room-objects)))
(not (and (member obj-jar dun-inventory) (not (and (member obj-jar dun-inventory)
(member objnum dun-jar))) (member objnum dun-jar)))
(not (member objnum (not (member objnum (nth dun-current-room dun-room-silents)))
(nth dun-current-room dun-room-silents)))
(not (member objnum dun-inventory))) (not (member objnum dun-inventory)))
(dun-mprincl "I don't see that here.") (dun-mprincl "I don't see that here."))
(if (>= objnum 0) ((>= objnum 0)
(if (and (= objnum obj-bone) (if (and (= objnum obj-bone)
(= dun-current-room marine-life-area) dun-black) (= dun-current-room marine-life-area) dun-black)
(dun-mprincl (dun-mprincl
@ -1421,11 +1412,10 @@ through.")))))
For an explosive time, go to Fourth St. and Vermont.") For an explosive time, go to Fourth St. and Vermont.")
(if (nth objnum dun-physobj-desc) (if (nth objnum dun-physobj-desc)
(dun-mprincl (nth objnum dun-physobj-desc)) (dun-mprincl (nth objnum dun-physobj-desc))
(dun-mprincl "I see nothing special about that."))) (dun-mprincl "I see nothing special about that."))))
(if (nth (abs objnum) dun-permobj-desc) ((nth (abs objnum) dun-permobj-desc)
(progn
(dun-mprincl (nth (abs objnum) dun-permobj-desc))) (dun-mprincl (nth (abs objnum) dun-permobj-desc)))
(dun-mprincl "I see nothing special about that."))))))))) (t (dun-mprincl "I see nothing special about that.")))))
(defun dun-take (obj) (defun dun-take (obj)
(setq obj (dun-firstword obj)) (setq obj (dun-firstword obj))
@ -1447,10 +1437,8 @@ For an explosive time, go to Fourth St. and Vermont.")
(dun-mprincl "Nothing to take.")))) (dun-mprincl "Nothing to take."))))
(let (objnum) (let (objnum)
(setq objnum (cdr (assq (intern obj) dun-objnames))) (setq objnum (cdr (assq (intern obj) dun-objnames)))
(if (eq objnum nil) (if (null objnum)
(progn (dun-mprincl "I don't know what that is.")
(dun-mprinc "I don't know what that is.")
(dun-mprinc "\n"))
(if (and dun-inbus (not (and (member objnum dun-jar) (if (and dun-inbus (not (and (member objnum dun-jar)
(member obj-jar dun-inventory)))) (member obj-jar dun-inventory))))
(dun-mprincl "You can't take anything while on the bus.") (dun-mprincl "You can't take anything while on the bus.")
@ -1485,12 +1473,12 @@ For an explosive time, go to Fourth St. and Vermont.")
(dun-mprinc "\n"))) (dun-mprinc "\n")))
(defun dun-inven-weight () (defun dun-inven-weight ()
(let (total) (let ((total 0))
(setq total 0)
(dolist (x dun-jar) (dolist (x dun-jar)
(setq total (+ total (nth x dun-object-lbs)))) (setq total (+ total (nth x dun-object-lbs))))
(dolist (x dun-inventory) (dolist (x dun-inventory)
(setq total (+ total (nth x dun-object-lbs)))) total)) (setq total (+ total (nth x dun-object-lbs))))
total))
;;; We try to take an object that is untakable. Print a message ;;; We try to take an object that is untakable. Print a message
;;; depending on what it is. ;;; depending on what it is.
@ -1533,16 +1521,17 @@ For an explosive time, go to Fourth St. and Vermont.")
notice that the tree is very unsteady."))))) notice that the tree is very unsteady.")))))
(defun dun-eat (obj) (defun dun-eat (obj)
(let (objnum) (let ((objnum (dun-objnum-from-args-std obj)))
(when (setq objnum (dun-objnum-from-args-std obj)) (when objnum
(if (not (member objnum dun-inventory)) (cond
(dun-mprincl "You don't have that.") ((not (member objnum dun-inventory))
(if (not (= objnum obj-food)) (dun-mprincl "You don't have that."))
(progn ((/= objnum obj-food)
(dun-mprinc "You forcefully shove ") (dun-mprinc "You forcefully shove ")
(dun-mprinc (downcase (cadr (nth objnum dun-objects)))) (dun-mprinc (downcase (cadr (nth objnum dun-objects))))
(dun-mprincl " down your throat, and start choking.") (dun-mprincl " down your throat, and start choking.")
(dun-die "choking")) (dun-die "choking"))
(t
(dun-mprincl "That tasted horrible.") (dun-mprincl "That tasted horrible.")
(dun-remove-obj-from-inven obj-food)))))) (dun-remove-obj-from-inven obj-food))))))
@ -1580,32 +1569,30 @@ notice that the tree is very unsteady.")))))
(if (= obj2 obj-disposal) (setq obj2 obj-chute)) (if (= obj2 obj-disposal) (setq obj2 obj-chute))
(if (and (= obj1 obj-cpu) (= obj2 obj-computer)) (cond
(progn ((and (= obj1 obj-cpu) (= obj2 obj-computer))
(dun-remove-obj-from-inven obj-cpu) (dun-remove-obj-from-inven obj-cpu)
(setq dun-computer t) (setq dun-computer t)
(dun-mprincl (dun-mprincl
"As you put the CPU board in the computer, it immediately springs to life. "As you put the CPU board in the computer, it immediately springs to life.
The lights start flashing, and the fans seem to startup.")) The lights start flashing, and the fans seem to startup."))
(if (and (= obj1 obj-weight) (= obj2 obj-button)) ((and (= obj1 obj-weight) (= obj2 obj-button))
(dun-drop '("weight")) (dun-drop '("weight")))
(if (= obj2 obj-jar) ;; Put something in jar ((= obj2 obj-jar) ; Put something in jar
(if (not (member obj1 (list obj-paper obj-diamond obj-emerald (if (not (member obj1 (list obj-paper obj-diamond obj-emerald
obj-license obj-coins obj-egg obj-license obj-coins obj-egg
obj-nitric obj-glycerine))) obj-nitric obj-glycerine)))
(dun-mprincl "That will not fit in the jar.") (dun-mprincl "That will not fit in the jar.")
(dun-remove-obj-from-inven obj1) (dun-remove-obj-from-inven obj1)
(setq dun-jar (append dun-jar (list obj1))) (setq dun-jar (append dun-jar (list obj1)))
(dun-mprincl "Done.")) (dun-mprincl "Done.")))
(if (= obj2 obj-chute) ;; Put something in chute ((= obj2 obj-chute) ; Put something in chute
(progn
(dun-remove-obj-from-inven obj1) (dun-remove-obj-from-inven obj1)
(dun-mprincl (dun-mprincl "You hear it slide down the chute and off into the distance.")
"You hear it slide down the chute and off into the distance.")
(dun-put-objs-in-treas (list obj1))) (dun-put-objs-in-treas (list obj1)))
(if (= obj2 obj-box) ;; Put key in key box ((= obj2 obj-box) ; Put key in key box
(if (= obj1 obj-key) (if (/= obj1 obj-key)
(progn (dun-mprincl "You can't put that in the key box!")
(dun-mprincl (dun-mprincl
"As you drop the key, the box begins to shake. Finally it explodes "As you drop the key, the box begins to shake. Finally it explodes
with a bang. The key seems to have vanished!") with a bang. The key seems to have vanished!")
@ -1615,30 +1602,26 @@ with a bang. The key seems to have vanished!")
dun-room-objects) dun-room-objects)
(list obj1))) (list obj1)))
(dun-remove-obj-from-room dun-current-room obj-box) (dun-remove-obj-from-room dun-current-room obj-box)
(setq dun-key-level (1+ dun-key-level))) (setq dun-key-level (1+ dun-key-level))))
(dun-mprincl "You can't put that in the key box!"))
(if (and (= obj1 obj-floppy) (= obj2 obj-pc)) ((and (= obj1 obj-floppy) (= obj2 obj-pc))
(progn
(setq dun-floppy t) (setq dun-floppy t)
(dun-remove-obj-from-inven obj1) (dun-remove-obj-from-inven obj1)
(dun-mprincl "Done.")) (dun-mprincl "Done."))
(if (= obj2 obj-urinal) ;; Put object in urinal ((= obj2 obj-urinal) ; Put object in urinal
(progn
(dun-remove-obj-from-inven obj1) (dun-remove-obj-from-inven obj1)
(dun-replace dun-room-objects urinal (append (dun-replace dun-room-objects urinal (append
(nth urinal dun-room-objects) (nth urinal dun-room-objects)
(list obj1))) (list obj1)))
(dun-mprincl (dun-mprincl "You hear it plop down in some water below."))
"You hear it plop down in some water below.")) ((= obj2 obj-mail)
(if (= obj2 obj-mail) (dun-mprincl "The mail chute is locked."))
(dun-mprincl "The mail chute is locked.") ((member obj1 dun-inventory)
(if (member obj1 dun-inventory)
(dun-mprincl (dun-mprincl
"I don't know how to combine those objects. Perhaps you should "I don't know how to combine those objects. Perhaps you should
just try dropping it.") just try dropping it."))
(dun-mprincl "You can't put that there."))))))))))) (t (dun-mprincl "You can't put that there."))))
(defun dun-type (_args) (defun dun-type (_args)
(if (not (= dun-current-room computer-room)) (if (not (= dun-current-room computer-room))
@ -1890,23 +1873,21 @@ huge rocks sliding down from the ceiling, and blocking your way out.\n")
(dun-mprincl (dun-mprincl
"The dial will not turn further in that direction.") "The dial will not turn further in that direction.")
(setq dun-sauna-level 0)) (setq dun-sauna-level 0))
(dun-sauna-heat)))))))) (dun-sauna-heat dun-sauna-level))))))))
(defun dun-sauna-heat () (defun dun-sauna-heat (level)
(if (= dun-sauna-level 0) (cond
(dun-mprincl ((= level 0)
"The temperature has returned to normal room temperature.")) (dun-mprincl "The temperature has returned to normal room temperature."))
(if (= dun-sauna-level 1) ((= level 1)
(dun-mprincl "It is now luke warm in here. You are perspiring.")) (dun-mprincl "It is now luke warm in here. You are perspiring."))
(if (= dun-sauna-level 2) ((= level 2)
(dun-mprincl "It is pretty hot in here. It is still very comfortable.")) (dun-mprincl "It is pretty hot in here. It is still very comfortable."))
(if (= dun-sauna-level 3) ((= level 3)
(progn
(dun-mprincl (dun-mprincl
"It is now very hot. There is something very refreshing about this.") "It is now very hot. There is something very refreshing about this.")
(if (or (member obj-rms dun-inventory) (when (or (member obj-rms dun-inventory)
(member obj-rms (nth dun-current-room dun-room-objects))) (member obj-rms (nth dun-current-room dun-room-objects)))
(progn
(dun-mprincl (dun-mprincl
"You notice the wax on your statuette beginning to melt, until it completely "You notice the wax on your statuette beginning to melt, until it completely
melts off. You are left with a beautiful diamond!") melts off. You are left with a beautiful diamond!")
@ -1918,45 +1899,41 @@ melts off. You are left with a beautiful diamond!")
(dun-remove-obj-from-room dun-current-room obj-rms) (dun-remove-obj-from-room dun-current-room obj-rms)
(dun-replace dun-room-objects dun-current-room (dun-replace dun-room-objects dun-current-room
(append (nth dun-current-room dun-room-objects) (append (nth dun-current-room dun-room-objects)
(list obj-diamond)))))) (list obj-diamond)))))
(if (or (member obj-floppy dun-inventory) (when (or (member obj-floppy dun-inventory)
(member obj-floppy (nth dun-current-room dun-room-objects))) (member obj-floppy (nth dun-current-room dun-room-objects)))
(progn
(dun-mprincl (dun-mprincl
"You notice your floppy disk beginning to melt. As you grab for it, the "You notice your floppy disk beginning to melt. As you grab for it, the
disk bursts into flames, and disintegrates.") disk bursts into flames, and disintegrates.")
(if (member obj-floppy dun-inventory) (if (member obj-floppy dun-inventory)
(dun-remove-obj-from-inven obj-floppy) (dun-remove-obj-from-inven obj-floppy)
(dun-remove-obj-from-room dun-current-room obj-floppy)))))) (dun-remove-obj-from-room dun-current-room obj-floppy))))
(if (= dun-sauna-level 4) ((= level 4)
(progn (dun-mprincl "As the dial clicks into place, you immediately burst into flames.")
(dun-mprincl
"As the dial clicks into place, you immediately burst into flames.")
(dun-die "burning")))) (dun-die "burning"))))
(defun dun-press (obj) (defun dun-press (obj)
(let (objnum) (let ((objnum (dun-objnum-from-args-std obj)))
(when (setq objnum (dun-objnum-from-args-std obj)) (cond
(if (not (or (member objnum (nth dun-current-room dun-room-objects)) ((not (or (member objnum (nth dun-current-room dun-room-objects))
(member objnum (nth dun-current-room dun-room-silents)))) (member objnum (nth dun-current-room dun-room-silents))))
(dun-mprincl "I don't see that here.") (dun-mprincl "I don't see that here."))
(if (not (member objnum (list obj-button obj-switch))) ((not (member objnum (list obj-button obj-switch)))
(progn
(dun-mprinc "You can't ") (dun-mprinc "You can't ")
(dun-mprinc (car line-list)) (dun-mprinc (car line-list))
(dun-mprincl " that.")) (dun-mprincl " that."))
(if (= objnum obj-button) ((= objnum obj-button)
(dun-mprincl (dun-mprincl
"As you press the button, you notice a passageway open up, but "As you press the button, you notice a passageway open up, but
as you release it, the passageway closes.")) as you release it, the passageway closes."))
(if (= objnum obj-switch) ((= objnum obj-switch)
(if dun-black (if dun-black
(progn (progn
(dun-mprincl "The button is now in the off position.") (dun-mprincl "The button is now in the off position.")
(setq dun-black nil)) (setq dun-black nil))
(dun-mprincl "The button is now in the on position.") (dun-mprincl "The button is now in the on position.")
(setq dun-black t)))))))) (setq dun-black t))))))
(defun dun-swim (_args) (defun dun-swim (_args)
(if (not (member dun-current-room (list lakefront-north lakefront-south))) (if (not (member dun-current-room (list lakefront-north lakefront-south)))
@ -2376,15 +2353,14 @@ for a moment, then straighten yourself up.
;;; Load an encrypted file, and eval it. ;;; Load an encrypted file, and eval it.
(defun dun-load-d (filename) (defun dun-load-d (filename)
(let (old-buffer result) (let ((old-buffer (current-buffer))
(setq result t) (result t))
(setq old-buffer (current-buffer))
(switch-to-buffer (get-buffer-create "*loadc*")) (switch-to-buffer (get-buffer-create "*loadc*"))
(erase-buffer) (erase-buffer)
(condition-case nil (condition-case nil
(insert-file-contents filename) (insert-file-contents filename)
(error (setq result nil))) (error (setq result nil)))
(unless (not result) (when result
(condition-case nil (condition-case nil
(dun-rot13) (dun-rot13)
(error (yank))) (error (yank)))
@ -2397,7 +2373,6 @@ for a moment, then straighten yourself up.
(defun dun-remove-obj-from-room (room objnum) (defun dun-remove-obj-from-room (room objnum)
(let (newroom) (let (newroom)
(setq newroom nil)
(dolist (x (nth room dun-room-objects)) (dolist (x (nth room dun-room-objects))
(if (not (= x objnum)) (if (not (= x objnum))
(setq newroom (append newroom (list x))))) (setq newroom (append newroom (list x)))))
@ -2405,7 +2380,6 @@ for a moment, then straighten yourself up.
(defun dun-remove-obj-from-inven (objnum) (defun dun-remove-obj-from-inven (objnum)
(let (new-inven) (let (new-inven)
(setq new-inven nil)
(dolist (x dun-inventory) (dolist (x dun-inventory)
(if (not (= x objnum)) (if (not (= x objnum))
(setq new-inven (append new-inven (list x))))) (setq new-inven (append new-inven (list x)))))
@ -2567,24 +2541,19 @@ Note: Restricted bourne shell in use.\n")))
(setq dungeon-mode 'dungeon))) (setq dungeon-mode 'dungeon)))
(defun dun-ls (args) (defun dun-ls (args)
(let ((ocdroom dun-cdroom))
(if (car args) (if (car args)
(let (ocdpath ocdroom) (let ((ocdpath dun-cdpath))
(setq ocdpath dun-cdpath)
(setq ocdroom dun-cdroom)
(if (not (eq (dun-cd args) -2)) (if (not (eq (dun-cd args) -2))
(dun-ls nil)) (dun-ls nil))
(setq dun-cdpath ocdpath) (setq dun-cdpath ocdpath)
(setq dun-cdroom ocdroom)) (setq dun-cdroom ocdroom))
(if (= dun-cdroom -10) (cond
(dun-ls-inven)) ((= ocdroom -10) (dun-ls-inven))
(if (= dun-cdroom -2) ((= ocdroom -2) (dun-ls-rooms))
(dun-ls-rooms)) ((= ocdroom -3) (dun-ls-root))
(if (= dun-cdroom -3) ((= ocdroom -4) (dun-ls-usr))
(dun-ls-root)) ((> ocdroom 0) (dun-ls-room))))))
(if (= dun-cdroom -4)
(dun-ls-usr))
(if (> dun-cdroom 0)
(dun-ls-room))))
(defun dun-ls-root () (defun dun-ls-root ()
(dun-mprincl "total 4 (dun-mprincl "total 4
@ -2853,80 +2822,63 @@ drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..")
(dun-uexit nil)))))))) (dun-uexit nil))))))))
(defun dun-cd (args) (defun dun-cd (args)
(let (tcdpath tcdroom path-elements room-check)
(if (not (car args)) (if (not (car args))
(dun-mprincl "Usage: cd <path>") (dun-mprincl "Usage: cd <path>")
(setq tcdpath dun-cdpath) (let ((tcdpath dun-cdpath)
(setq tcdroom dun-cdroom) (tcdroom dun-cdroom)
path-elements)
(setq dun-badcd nil) (setq dun-badcd nil)
(condition-case nil (condition-case nil
(setq path-elements (dun-get-path (car args) nil)) (setq path-elements (dun-get-path (car args) nil))
(error (dun-mprincl "Invalid path") (error (dun-mprincl "Invalid path")
(setq dun-badcd t))) (setq dun-badcd t)))
(dolist (pe path-elements) (dolist (pe path-elements)
(unless dun-badcd (when (and (not dun-badcd)
(if (not (string= pe ".")) (not (string= pe ".")))
(if (string= pe "..") (cond
(progn ((string= pe "..")
(if (> tcdroom 0) ;In a room (cond
(progn ((> tcdroom 0) ;In a room
(setq tcdpath "/rooms") (setq tcdpath "/rooms")
(setq tcdroom -2)) (setq tcdroom -2))
;In /rooms,/usr,root ((memq tcdroom '(-2 -3 -4)) ; In /rooms,/usr,root
(if (or
(= tcdroom -2) (= tcdroom -4)
(= tcdroom -3))
(progn
(setq tcdpath "/") (setq tcdpath "/")
(setq tcdroom -3)) (setq tcdroom -3))
(if (= tcdroom -10) ;In /usr/toukmond ((= tcdroom -10)
(progn
(setq tcdpath "/usr") (setq tcdpath "/usr")
(setq tcdroom -4)))))) (setq tcdroom -4))))
(if (string= pe "/") ((string= pe "/")
(progn
(setq tcdpath "/") (setq tcdpath "/")
(setq tcdroom -3)) (setq tcdroom -3))
(if (= tcdroom -4) ((= tcdroom -4)
(if (string= pe "toukmond") (if (not (string= pe "toukmond"))
(progn (dun-nosuchdir)
(setq tcdpath "/usr/toukmond") (setq tcdpath "/usr/toukmond")
(setq tcdroom -10)) (setq tcdroom -10)))
(dun-nosuchdir)) ((or (= tcdroom -10) (> tcdroom 0)) (dun-nosuchdir))
(if (= tcdroom -10) ((= tcdroom -3)
(dun-nosuchdir) (cond
(if (> tcdroom 0) ((string= pe "rooms")
(dun-nosuchdir)
(if (= tcdroom -3)
(progn
(if (string= pe "rooms")
(progn
(setq tcdpath "/rooms") (setq tcdpath "/rooms")
(setq tcdroom -2)) (setq tcdroom -2))
(if (string= pe "usr") ((string= pe "usr")
(progn
(setq tcdpath "/usr") (setq tcdpath "/usr")
(setq tcdroom -4)) (setq tcdroom -4))
(dun-nosuchdir)))) (t (dun-nosuchdir))))
(if (= tcdroom -2) ((= tcdroom -2)
(progn (let (room-check)
(dolist (x dun-visited) (dolist (x dun-visited)
(setq room-check (setq room-check (nth x dun-room-shorts))
(nth x (when (string= room-check pe)
dun-room-shorts)) (setq tcdpath (concat "/rooms/" room-check))
(if (string= room-check pe)
(progn
(setq tcdpath
(concat "/rooms/" room-check))
(setq tcdroom x)))) (setq tcdroom x))))
(if (= tcdroom -2) (when (= tcdroom -2)
(dun-nosuchdir))))))))))))) (dun-nosuchdir))))))
(if (not dun-badcd) (if dun-badcd
(progn -2
(setq dun-cdpath tcdpath) (setq dun-cdpath tcdpath)
(setq dun-cdroom tcdroom) (setq dun-cdroom tcdroom)
0) 0))))
-2))))
(defun dun-nosuchdir () (defun dun-nosuchdir ()
(dun-mprincl "No such directory.") (dun-mprincl "No such directory.")