← Back to branch summary

~ubuntu-branches/ubuntu/natty/sawfish/natty

« back to all changes in this revision

Viewing changes to lisp/sawfish/wm/util/prompt.jl

  • Committer: Bazaar Package Importer
  • Author(s): Luis Rodrigo Gallardo Cruz
  • Date: 2009-11-23 09:05:20 UTC
  • mfrom: (0.1.1 upstream)
  • mto: This revision was merged to the branch mainline in revision 17.
  • Revision ID: james.westby@ubuntu.com-20091123090520-m588qe37wtxzr2b5
Tags: upstream-1.5.3
Import upstream version 1.5.3

Show diffs side-by-side

added added

removed removed

Lines of Context:
lisp/sawfish/wm/util/prompt.jl
1
1
;; prompt.jl -- read line from user
2
2
;; Time-stamp: <2000-02-25 22:02:54 tjp>
3
3
;;
 
4
;; Copyright (C) 2008 Sergey I. Sharybin <sharybin@nm.ru>
4
5
;; Copyright (C) 2000 Topi Paavola <tjp@iki.fi>
5
6
;;   
6
7
;; This file is free software; you can redistribute it and/or modify it
53
54
          rep.regexp
54
55
          rep.data.ring
55
56
          sawfish.wm.misc
 
57
          sawfish.wm.colors
56
58
          sawfish.wm.events
57
59
          sawfish.wm.custom
58
 
          sawfish.wm.commands)
 
60
          sawfish.wm.commands
 
61
          sawfish.wm.fonts)
 
62
 
 
63
  (defgroup messages "Messages" :group misc)
 
64
 
 
65
(defcustom prompt-font default-font
 
66
  "Font for prompt: \\w"
 
67
  :type font
 
68
  :group (misc messages))
 
69
 
 
70
(defcustom prompt-color (cons (get-color "black") (get-color "white"))
 
71
    "Prompt message's colors."
 
72
    :type (pair (labelled "Foreground:" color) (labelled "Background:" color))
 
73
    :group (misc messages))
59
74
 
60
75
  (define-structure-alias prompt sawfish.wm.util.prompt)
61
76
 
102
117
  (defvar prompt-completions-outdated nil)
103
118
  (defvar prompt-history-pos nil)
104
119
  (defvar prompt-saved nil)
 
120
  (defvar prompt-attr nil)
 
121
 
 
122
 
 
123
;; From merlin
 
124
;; But maybe better if we'd include this util?
 
125
 
 
126
  ;; string/font -> font
 
127
  (define (prompt-fontify font)
 
128
    (if (stringp font) (get-font font) font))
 
129
 
 
130
  ;; string/color -> color
 
131
  (define (prompt-colorify color)
 
132
    (if (stringp color) (get-color color) color))
 
133
 
 
134
  ;; assq with default
 
135
  (define (prompt-assqd key alist default)
 
136
    (if (assq key alist)
 
137
      (assq key alist)
 
138
      (cons key default)))
105
139
 
106
140
  (defun prompt-exit ()
107
141
    "Cancel string input."
266
300
                      (prompt-display-fun prompt-result)
267
301
                   prompt-result))
268
302
         (completions (prompt-format-completions)))
269
 
      (display-message (concat completions
 
303
     (let
 
304
       (
 
305
         (fg (prompt-colorify (cdr (prompt-assqd 'foreground prompt-attr (car prompt-color)))))
 
306
         (bg (prompt-colorify (cdr (prompt-assqd 'background prompt-attr (cdr prompt-color)))))
 
307
         (font (prompt-fontify (cdr (prompt-assqd 'font prompt-attr prompt-font))))
 
308
       )
 
309
       (display-message
 
310
         (concat completions
270
311
                              (when completions "\n\n")
271
312
                               prompt-prompt
272
313
                               (substring result 0 prompt-position)
273
314
                               ?| (substring result prompt-position))
274
 
                       `((position . ,prompt-window-position)))))
 
315
                       `((position . ,prompt-window-position)
 
316
             (foreground . ,fg)
 
317
             (background . ,bg)
 
318
             (font . , font)
 
319
             )))))
275
320
 
276
321
  ;; Insert all unbound keys to result.
277
322
  (defun prompt-unbound-callback ()
285
330
      (prompt-update-display)
286
331
      t))
287
332
 
288
 
  (defun prompt (#!optional title start)
 
333
  (defun prompt (#!optional title start attributes)
289
334
    "Prompt the user for a string."
290
335
    (unless (stringp title)
291
336
      (setq title "Enter string:"))
300
345
                  (prompt-position (length prompt-result))
301
346
                  (prompt-history-pos 0)
302
347
                  (prompt-saved nil)
 
348
                  (prompt-attr attributes)
303
349
                  (prompt-completion-position nil)
304
350
                  (prompt-completions nil)
305
351
                  (prompt-completions-outdated t)
340
386
  (defun prompt-for-command (#!optional title)
341
387
    (prompt-for-symbol title commandp commandp))
342
388
 
 
389
 
343
390
;;; autoloads
344
391
 
345
392
  (autoload 'prompt-for-file "sawfish/wm/util/prompt-extras")
352
399
  (autoload 'prompt-for-window "sawfish/wm/util/prompt-wm")
353
400
  (autoload 'prompt-for-workspace "sawfish/wm/util/prompt-wm")
354
401
 
 
402
 
355
403
;;; init keymap
356
404
 
357
405
  (bind-keys prompt-keymap