Improve output of 'set' command.
tswd
4 years ago
| 266 | 266 | (defun show-modes (flg) |
| 267 | 267 | (if (eq flg t) |
| 268 | 268 | (let ((*print-line-limit* 62)) |
| 269 | (format t "~%switch~24Tvalue~%--------------------------------------------------------------") | |
| 269 | (format t "~%switch~24Tvalue~%========================================================") | |
| 270 | 270 | (dolist (sw *chaos-switches*) |
| 271 | 271 | (unless (chaos-switch-hidden sw) |
| 272 | 272 | (show-mode sw)))) |
| 273 | 273 | (let ((sw flg)) |
| 274 | 274 | (if (or (equal sw '(".")) (null sw)) |
| 275 | 275 | (show-modes t) |
| 276 | (let ((which (car flg)) | |
| 276 | (let ((which (car flg)) | |
| 277 | 277 | (sub (cdr flg)) |
| 278 | 278 | (found nil) |
| 279 | 279 | (cand nil)) |
| 280 | (dolist (sw *chaos-switches*) | |
| 280 | (dolist (sw *chaos-switches*) | |
| 281 | 281 | (block next |
| 282 | 282 | (let ((key (chaos-switch-key sw))) |
| 283 | 283 | (when (eq key :comment) (return-from next nil)) |
| 284 | 284 | (when (atom key) (setq key (list key))) |
| 285 | 285 | (when (member which key :test #'equal) |
| 286 | (setq cand sw) | |
| 286 | ;; (setq cand sw) | |
| 287 | (push sw cand) | |
| 287 | 288 | (let ((opt (chaos-switch-subkey sw))) |
| 288 | 289 | (when (equal opt (firstn sub (length opt))) |
| 289 | (setq found sw) | |
| 290 | (setq cand nil) | |
| 291 | (return))))))) | |
| 292 | (unless (or found cand) | |
| 290 | (setq found sw))))))) | |
| 291 | (unless (or found cand) | |
| 293 | 292 | (with-output-chaos-warning () |
| 294 | 293 | (format t "unknown switch ~a" flg) |
| 295 | 294 | (return-from show-modes nil))) |
| 296 | (if found | |
| 295 | (if found | |
| 297 | 296 | (show-mode found) |
| 298 | (show-mode cand))))))) | |
| 297 | (dolist (sw cand) | |
| 298 | (show-mode sw)))))))) | |
| 299 | 299 | |
| 300 | 300 | (defun show-mode (switch) |
| 301 | 301 | (let ((name (chaos-switch-key switch)) |
| 305 | 305 | (cond ((eq name :comment) |
| 306 | 306 | (format t "~%~a" (second switch))) |
| 307 | 307 | ((equal name "libpath") |
| 308 | (format t "~%libpath~24T= ~{~a~^:~}" value)) | |
| 308 | (format t "~%libpath~24T ~{~a~^:~}" value)) | |
| 309 | 309 | (t (when (atom name) (setq name (list name))) |
| 310 | 310 | (if (eq type 'parity) |
| 311 | 311 | (format t "~%~{~a~^|~a~} ~{~^ ~a~} ~24T~:[off~;on~]" name option value) |
| 312 | (progn (format t "~%~{~a~^|~a~} ~{~^ ~a~} ~24T= " name option) | |
| 312 | (progn (format t "~%~{~a~^|~a~} ~{~^ ~a~} ~24T" name option) | |
| 313 | 313 | (if value |
| 314 | 314 | (print-chaos-object value) |
| 315 | 315 | (princ "not specified")))))))) |