← Back to branch summary

~ubuntu-branches/ubuntu/lucid/sawfish/lucid-updates

« back to all changes in this revision

Viewing changes to lisp/sawfish/wm/commands/help.jl

  • Committer: Bazaar Package Importer
  • Author(s): Christian Marillat
  • Date: 2002-01-20 17:42:28 UTC
  • Revision ID: james.westby@ubuntu.com-20020120174228-4q1ydztbkvfq1ht2
Tags: upstream-1.0.1.20020116
Import upstream version 1.0.1.20020116

Show diffs side-by-side

added added

removed removed

Lines of Context:
lisp/sawfish/wm/commands/help.jl
 
1
;; help.jl -- commands for the help menu
 
2
;; $Id: help.jl,v 1.5 2000/09/11 07:44:42 john Exp $
 
3
 
 
4
;; Copyright (C) 2000 John Harper <john@dcs.warwick.ac.uk>
 
5
 
 
6
;; This file is part of sawmill.
 
7
 
 
8
;; sawmill is free software; you can redistribute it and/or modify it
 
9
;; under the terms of the GNU General Public License as published by
 
10
;; the Free Software Foundation; either version 2, or (at your option)
 
11
;; any later version.
 
12
 
 
13
;; sawmill is distributed in the hope that it will be useful, but
 
14
;; WITHOUT ANY WARRANTY; without even the implied warranty of
 
15
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
16
;; GNU General Public License for more details.
 
17
 
 
18
;; You should have received a copy of the GNU General Public License
 
19
;; along with sawmill; see the file COPYING.  If not, write to
 
20
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
21
 
 
22
(define-structure sawfish.wm.commands.help
 
23
 
 
24
    (export display-url
 
25
            help-call-info
 
26
            help-call-info-gnome)
 
27
 
 
28
    (open rep
 
29
          rep.system
 
30
          rep.regexp
 
31
          rep.io.files
 
32
          sawfish.wm.commands)
 
33
 
 
34
  ;; Info
 
35
 
 
36
  (define (help-call-info document node)
 
37
    (system (format nil "xterm -e info '%s' '%s' >/dev/null 2>&1 </dev/null &"
 
38
                    document node)))
 
39
 
 
40
  (define (help-call-info-gnome document node)
 
41
    (while (string-match " " node)
 
42
      (setq node (concat (substring node 0 (match-start)) ?_
 
43
                         (substring node (match-end)))))
 
44
    (system (format nil "gnome-help-browser 'info:%s#%s' >/dev/null 2>&1 </dev/null &"
 
45
                    document node)))
 
46
 
 
47
  (defvar help-display-info-function help-call-info)
 
48
 
 
49
  ;; WWW
 
50
 
 
51
  (defvar display-url-command
 
52
    "( netscape -remote 'openUrl(%s)' || netscape '%s' ) &"
 
53
    "Shell command used to direct a web browser to load a url. Any `%s'
 
54
substrings will be replaced by the name of the url.")
 
55
 
 
56
  (define (display-url url)
 
57
    (let ((args (list url)))
 
58
      (rplacd args args)
 
59
      (system (apply format nil display-url-command args))))
 
60
 
 
61
  ;; Commands
 
62
 
 
63
  (define (show-faq) (help-display-info-function "sawfish" "FAQ"))
 
64
 
 
65
  (define (show-news) (help-display-info-function "sawfish" "News"))
 
66
 
 
67
  (define (show-programmer-manual)
 
68
    (help-display-info-function "sawfish" "Top"))
 
69
 
 
70
  (define (show-homepage) (display-url "http://sawmill.sourceforge.net/"))
 
71
 
 
72
  (define (show-about)
 
73
    (system (format nil "%s >/dev/null 2>&1 </dev/null &"
 
74
                    (expand-file-name "sawfish-about"
 
75
                                      sawfish-exec-directory))))
 
76
 
 
77
  ;;###autoload
 
78
  (define-command 'help:show-faq show-faq)
 
79
  (define-command 'help:show-news show-news)
 
80
  (define-command 'help:show-programmer-manual show-programmer-manual)
 
81
  (define-command 'help:show-homepage show-homepage)
 
82
  (define-command 'help:about show-about))