--- core.lisp-OLD 2007-06-15 09:37:35.000000000 -0400 +++ core.lisp 2007-06-29 01:26:36.000000000 -0400 @@ -2203,7 +2203,9 @@ (unmap-message-window (current-screen)) (if cmd (interactive-command cmd) - (message "~{~a ~}not bound." (mapcar 'print-key (nreverse key-seq))))))))) + (if *nethack* + (message "You don't have that keybinding (~{~a ~})." (mapcar 'print-key (nreverse key-seq))) + (message "~{~a ~}not bound." (mapcar 'print-key (nreverse key-seq)))))))))) (defun bytes-to-window (bytes) "A sick hack to assemble 4 bytes into a 32 bit number. This is --- primitives.lisp-OLD 2007-06-29 01:34:21.000000000 -0400 +++ primitives.lisp 2007-06-29 01:37:36.000000000 -0400 @@ -728,6 +728,13 @@ (defvar *startup-message* "Welcome to The Stump Window Manager!" "StumpWM's startup message. Set to NIL to suppress.") +(defvar *nethack* nil + "Should stumpwm display nethack-esque messages, a la GNU Screen? Set to NIL (the default) to suppress.") + +(defvar *nethack-startup-message* "Hello, welcome to the Stump Window Manager! +You are lucky! Full moon tonight." + "A nethacked startup message. Set to NIL to suppress.") + (defvar *default-package* (find-package "CL-USER") "What package does stumpwm startup in? This affects the package symbols are read into in the eval command and the package the rc --- stumpwm.lisp-OLD 2007-06-29 01:23:24.000000000 -0400 +++ stumpwm.lisp 2007-06-29 01:40:40.000000000 -0400 @@ -220,9 +220,14 @@ (let ((*package* (find-package *default-package*))) (multiple-value-bind (success err rc) (load-rc-file) (if success - (when *startup-message* - (message "~a" *startup-message*)) - (message "Error loading ~A: ~A" rc err)))) + (if *nethack* + (when *nethack-startup-message* + (message "~a" *nethack-startup-message*)) + (when *startup-message* + (message "~a" *startup-message*))) + (if *nethack* + (message "You have some trouble loading an rc file named ~A: ~A" rc err) + (message "Error loading ~A: ~A" rc err))))) ;; Let's manage. (let ((*package* (find-package *default-package*))) (run-hook *start-hook*) --- user.lisp-OLD 2007-06-29 01:13:48.000000000 -0400 +++ user.lisp 2007-06-29 01:28:12.000000000 -0400 @@ -244,7 +244,10 @@ (frame-raise-window group (window-frame nw) nw) (unless (eq (window-frame nw) old-frame) (show-frame-indicator group)))) - (message "No other window.")))) + (if *nethack* + (message "You cannot escape from window ~a!" + (window-number w)) + (message "No other window."))))) (defun delete-current-window () "Send a delete event to the current window." @@ -313,7 +316,9 @@ (define-stumpwm-command "title" ((title :rest "Set window's title to: ")) (if (current-window) (setf (window-user-title (current-window)) title) - (message "No Focused Window"))) + (if *nethack* + (message "Nothing happens") + (message "No Focused Window")))) (defun format-time-string (&optional time) "Return a formatted date-time string. FIXME: how about being able to pass a format string in?" @@ -375,9 +380,9 @@ (show-frame-indicator group)))) (defun programs-in-path (base &optional full-path (path (split-string (getenv "PATH") ":"))) - "Return a list of programs in the path that start with BASE. if -FULL-PATH is T then return the full path, otherwise just return -the filename." + "Return a list of programs in PATH that start with BASE. If +FULL-PATH is T then return the full path, otherwise just return the +filename." (loop for p in path for dir = (probe-file p) @@ -547,7 +552,9 @@ (define-stumpwm-command "resize" ((w :number "+ Width: ") (h :number "+ Height: ")) (if (atom (tile-group-frame-tree (current-group))) - (message "There's only 1 frame!") + (if *nethack* + (message "A single frame is a very silly thing to resize.") + (message "There's only 1 frame!")) (let* ((group (current-group)) (f (tile-group-current-frame group))) (resize-frame group f w :width) @@ -757,7 +764,7 @@ (define-stumpwm-type :shell (input prompt) (or (argument-pop-rest input) - (completing-read (current-screen) prompt 'programs-in-path))) + (completing-read (current-screen) prompt 'completions))) (define-stumpwm-type :rest (input prompt) (or (argument-pop-rest input) @@ -817,7 +824,9 @@ (message "~a" result)) ((eq result :abort) (unless *suppress-abort-messages* - (message "Abort.")))))) + (if *nethack* + (message "Nothing happens.") + (message "Abort."))))))) (define-stumpwm-command "colon" ((initial-input :rest)) (let ((cmd (completing-read (current-screen) ": " (all-commands) (or initial-input "")))) @@ -871,7 +880,9 @@ (progn (with-restarts-menu (load-rc-file nil))) (error (c) - (message "Error loading rc file: ~A" c)) + (if *nethack* + (message "You have some trouble loading an rc file named ~A" c) + (message "Error loading rc file: ~A" c))) (:no-error (&rest args) (declare (ignore args)) (message "rc file loaded successfully.")))) @@ -917,7 +928,9 @@ (define-stumpwm-command "abort" () ;; This way you can exit from command mode (when (pop-top-map) - (message "Exited."))) + (if *nethack* + (message "Nothing happens.") + (message "Exited.")))) (defun set-prefix-key (key) "Change the stumpwm prefix key to KEY." @@ -1075,7 +1088,9 @@ (setf *lastmsg-nth* 0)) (if (screen-last-msg (current-screen)) (echo-nth-last-message (current-screen) *lastmsg-nth*) - (message "No last message."))) + (if *nethack* + (message "You can't seem to remember any previous messages!") + (message "No last message.")))) ;;; A resize minor mode. Something a bit better should probably be ;;; written. But it's an interesting way of doing it. @@ -1114,21 +1129,29 @@ (define-stumpwm-command "iresize" () (if (atom (tile-group-frame-tree (current-group))) - (message "There's only 1 frame!") + (if *nethack* + (message "A single frame is a very silly thing to resize.") + (message "There's only 1 frame!")) (progn - (message "Resize Frame") + (if *nethack* + (message "You feel as though your frame keeps changing size!") + (message "Resize Frame")) (push-top-map *resize-map*)) ;; (setf *resize-backup* (copy-frame-tree screen)) )) (define-stumpwm-command "abort-iresize" () - (message "Abort resize") + (if *nethack* + (message "Your frame shudders for a moment") + (message "Abort resize")) ;; TODO: actually revert the frames (pop-top-map)) (define-stumpwm-command "exit-iresize" () - (message "Resize Complete") - (pop-top-map)) + (if *nethack* + (message "You feel like you have a whole new frame!") + (message "Resize Complete")) + (pop-top-map)) ;;; group commands @@ -1241,7 +1264,9 @@ (define-stumpwm-command "gmerge" ((from :group "From Group: ")) (if (eq from (current-group)) - (message "Cannot merge group with itself!") + (if *nethack* + (message "You feel as though this group is already as one.") + (message "Cannot merge group with itself!")) (merge-groups from (current-group)))) ;;; interactive menu @@ -1330,7 +1355,9 @@ (define-stumpwm-command "windowlist" ((fmt :rest)) (if (null (group-windows (current-group))) - (message "No Managed Windows") + (if *nethack* + (message "You feel alone") + (message "No Managed Windows")) (let* ((group (current-group)) (window (second (select-from-menu (current-screen) @@ -1473,7 +1500,9 @@ (tile-group-current-frame (current-group))))) (if tree (balance-frames (current-group) tree) - (message "There's only 1 frame!")))) + (if *nethack* + (message "Your frame is already as well-balanced as it can get.") + (message "There's only 1 frame!"))))) (define-stumpwm-command "describe-key" ((keys :key-seq "Describe Key: ")) (let ((cmd (lookup-key-sequence *top-map* keys)))