[patch] fdo-menu Re: fdo-menu breaks when LC_ALL unset & code suggestion
- From: Matthew Love <matth love gmail com>
- To: sawfish-list gnome org
- Subject: [patch] fdo-menu Re: fdo-menu breaks when LC_ALL unset & code suggestion
- Date: Sat, 19 Sep 2009 12:45:19 -0600
Teika Kazura <teika lavabit com> writes:
> Hi. Matthew, can you fix these?
>
> 1. The sawfish doesn't run if LC_ALL isn't set. There're several cases.
> a: When LC_ALL is not set at all, then it says:
> error--> (void-value name-string)
> b: When "LC_ALL=", then
> error--> (bad-arg #<subr substring> 2 3)
> c: (maybe a polymorph of b) "LC_ALL=foo",
> error--> (bad-arg #<subr substring> 5 3)
>
> This seems to differ from what Jeremy reported.
>
> 2. Code suggestion:
> "defvar" and "defun" make globals. For local symbols, could you
> replace them with "define", Like (define var-foo), and
> (define (foo-func arg1 arg2)) ?
>
> "unless batch-mode" seems peculiar to me, too, but not sure.
>
> Gee, fdo-menu is great. Astonishing. Thanks a lot.
> Teika (Teika kazura)
>
>
I think i got these fixed...let me know if it works for you.
- when LC_ALL (or any of the other env variables) are not set, will use
dummy string "xx", which will cause the language to use the default.
- when "LC_ALL=", or any string less than 2, will do the same as above.
- when "LC_ALL=foo" will use "fo" and fall back to default
name settings, unless a menu entry uses "Name[fo]=".
- fixed the problems Jeremy reported by exiling bad .desktop files
- replaced defun's with defines
- changed the names of a few variables
not sure what the 'unless-batch-mode is for either...
thanks :)
diff --git a/lisp/sawfish/wm/ext/fdo-menu.jl b/lisp/sawfish/wm/ext/fdo-menu.jl
index cbc2ab2..4673259 100644
--- a/lisp/sawfish/wm/ext/fdo-menu.jl
+++ b/lisp/sawfish/wm/ext/fdo-menu.jl
@@ -42,46 +42,50 @@
(unless batch-mode
(defvar this-line nil)
- (defvar *loc-menu* nil)
+ (defvar *fdo-local-menu*)
+ (defvar fdo-name-string "Name[")
(make-variable-special 'apps-menu)
;; fdo-desktop-file-parsing
- (defun desktop-file-p (directory-file)
+ (define (desktop-file-p directory-file)
(let ((this-file (open-file directory-file 'read)))
(string= (read-line this-file) "[Desktop Entry]\012")))
- (defun desktop-group-p (instring)
+ (define (desktop-group-p instring)
(string= (substring instring 0 1) "["))
- (defun desktop-skip-line-p (instring)
+ (define (desktop-skip-line-p instring)
(or (not instring)
(string= (substring instring 0 1) "#")
(string= (substring instring 0 1) "\012")))
- (defun get-key-break (instring key)
+ (define (get-key-break instring key)
(if instring
- (do ((mcount 0 (1+ mcount)))
- ((or (string= (substring instring mcount (+ mcount 1)) "\n")
- (string= (substring instring mcount (+ mcount 1)) key)
- (= mcount 398)) mcount))))
-
- (defun get-desktop-key (instring)
+ (let ((mlength (length instring)))
+ (do ((mcount 0 (1+ mcount)))
+ ((or (string= (substring instring mcount (+ mcount 1)) "\n")
+ (string= (substring instring mcount (+ mcount 1)) "\012")
+ (string= (substring instring mcount (+ mcount 1)) key)
+ (= mcount (- mlength 2))
+ (= mcount 398)) mcount)))))
+
+ (define (get-desktop-key instring)
(if (> (length instring) 3)
(let ((break-number (get-key-break instring "=")))
(if (< break-number 20)
(substring instring 0 break-number)))))
- (defun get-desktop-value (instring)
+ (define (get-desktop-value instring)
(if (> (length instring) 3)
(let ((break-number (get-key-break instring "=")))
(if (< break-number 20)
(substring instring (+ 1 break-number))))))
- (defun get-desktop-group (instring)
+ (define (get-desktop-group instring)
(substring instring 1 (- (length instring) 2)))
- (defun parse-desktop-file-line (infile)
+ (define (parse-desktop-file-line infile)
(if (setq this-line (read-line infile))
(if (not (desktop-skip-line-p this-line))
(cons
@@ -92,19 +96,18 @@
(parse-desktop-file-line infile))
(parse-desktop-file-line infile))))
- (defun parse-desktop-file (infile)
- (unless (not (desktop-file-p infile))
- (let ((d-file (open-file infile 'read)))
- (parse-desktop-file-line d-file))))
+ (define (parse-desktop-file infile)
+ (let ((d-file (open-file infile 'read)))
+ (parse-desktop-file-line d-file)))
;; generic functions
- (defun map-desk-files (in-desk-files in-directory)
+ (define (map-desk-files in-desk-files in-directory)
(if in-desk-files
(cons (expand-file-name (car in-desk-files) in-directory)
(map-desk-files (cdr in-desk-files) in-directory))))
- (defun map-dir-files (directories)
+ (define (map-dir-files directories)
(if directories
(if (file-directory-p (car directories))
(let ((desk0 (directory-files (car directories))))
@@ -112,52 +115,54 @@
(map-dir-files (cdr directories))))
(map-dir-files (cdr directories)))))
- (defun flatten (input)
+ (define (flatten input)
(cond ((null input) nil)
((atom input) (list input))
(t (append (flatten (car input))
(flatten (cdr input))))))
- (defun trim-end (string)
+ (define (trim-end string)
(cond
((string= (aref string (- (length string) 3)) 37)
(substring string 0 (- (length string) 4)))
(string
(substring string 0 (- (length string) 1)))))
- (defun find-lang-string ()
+ (define (find-lang-string)
(cond
((getenv "LANGUAGE")
(let ((mlang (getenv "LANGUAGE")))
- (if (> (length mlang) 2)
- (substring mlang 0 5)
- (substring mlang 0 2))))
+ (if (>= (length mlang) 2)
+ (if (>= (length mlang) 5)
+ (substring mlang 0 5)
+ (substring mlang 0 2)) "xx")))
((getenv "LC_ALL")
(let ((mlang (getenv "LC_ALL")))
- (if (> (length mlang) 2)
- (substring mlang 0 5)
- (substring mlang 0 2))))
+ (if (>= (length mlang) 2)
+ (if (>= (length mlang) 5)
+ (substring mlang 0 5)
+ (substring mlang 0 2)) "xx")))
((getenv "LC_MESSAGES")
(let ((mlang (getenv "LC_MESSAGES")))
- (if (> (length mlang) 2)
- (substring mlang 0 5)
- (substring mlang 0 2))))
+ (if (>= (length mlang) 2)
+ (if (>= (length mlang) 5)
+ (substring mlang 0 5)
+ (substring mlang 0 2)) "xx")))
((getenv "LANG")
(let ((mlang (getenv "LANG")))
- (if (> (length mlang) 2)
- (substring mlang 0 5)
- (substring mlang 0 2))))))
+ (if (>= (length mlang) 2)
+ (if (>= (length mlang) 5)
+ (substring mlang 0 5)
+ (substring mlang 0 2)) "xx")))
+ (t "xx")))
;; Variables that can be set in .sawfish[/]rc
- (if (not (boundp 'desktop-directory))
- (defvar desktop-directory '("/usr/share/applications")))
-
(if (not (boundp 'my-lang-string))
(defvar my-lang-string (find-lang-string)))
- (if my-lang-string
- (defvar name-string "Name["))
+ (if (not (boundp 'desktop-directory))
+ (defvar desktop-directory '("/usr/share/applications")))
(if (not (boundp 'ignore-no-display))
(defvar ignore-no-display '()))
@@ -206,18 +211,19 @@
"FileManager" "X-FileSystemMount" "Compression"))
("System" . ("X-SystemSchedule" "System" "X-SystemMemory" \
"TerminalEmulator" "Dictionary" "Puppy" "Printing" "Monitor" "Security"))
- ("Settings" . ("Settings" "HardwareSettings" "PackageManager"))))
+ ("Settings" . ("Settings" "HardwareSettings" "PackageManager"))
+ ("Exiles" . ("Exile"))))
;; Get the correct Name value based on language settings
- (defun find-lang-in-desktop-file (fdo-list)
- (if (assoc (concat name-string my-lang-string "]") fdo-list)
- (concat name-string my-lang-string "]")
- (if (assoc (concat name-string (substring my-lang-string 0 2) "]") fdo-list)
- (concat name-string (substring my-lang-string 0 2) "]")
+ (define (find-lang-in-desktop-file fdo-list)
+ (if (assoc (concat fdo-name-string my-lang-string "]") fdo-list)
+ (concat fdo-name-string my-lang-string "]")
+ (if (assoc (concat fdo-name-string (substring my-lang-string 0 2) "]") fdo-list)
+ (concat fdo-name-string (substring my-lang-string 0 2) "]")
"Name")))
;; Functions for categories
- (defun fix-sub-cats (cat-list loc-list)
+ (define (fix-sub-cats cat-list loc-list)
(if cat-list
(let ((cat-val (car cat-list)))
(if (assoc cat-val loc-list)
@@ -226,16 +232,16 @@
(fix-sub-cats (cdr cat-list) loc-list)))))
;; Associate values from the Master Category list with sub-categories from file
- (defun fix-cats (cat-list)
+ (define (fix-cats cat-list)
(if cat-list
(let ((cat-val (car (car cat-list)))
- (c-list (fix-sub-cats (car cat-list) *loc-menu*)))
+ (c-list (fix-sub-cats (car cat-list) *fdo-local-menu*)))
(if (car c-list)
(cons (cons cat-val c-list) (fix-cats (cdr cat-list)))
(fix-cats (cdr cat-list))))))
;; Convert a Categories key value from ; delineated records to a list
- (defun build-cat-list (line)
+ (define (build-cat-list line)
(if (> (length line) 1)
(let ((this-cat (prin1-to-string (read-from-string line))))
(cons this-cat
@@ -244,7 +250,7 @@
;; Helper for (parse-desk-line)
;; Determine best category to use... :|
- (defun parse-cat-list (cat-list)
+ (define (parse-cat-list cat-list)
(if (cdr cat-list)
(let ((this-cat (car cat-list)))
(if (or
@@ -259,18 +265,46 @@
(car cat-list)))
;; Alphabetize the entries in the category menus
- (defun alphabetize-entries (saw-menu)
+ (define (alphabetize-entries saw-menu)
(if saw-menu
(cons (cons (car (car saw-menu))
(sort (cdr (car saw-menu)) string<))
(alphabetize-entries (cdr saw-menu)))))
+ (define (fdo-exile fdo-list)
+ (setq fdo-list
+ (append fdo-list (cons (cons "fdo-Comment" "This .desktop file was exiled, use with caution, file may be corrupt.\n"))))
+ (if (assoc "NoDisplay" fdo-list)
+ (rplacd (assoc "NoDisplay" fdo-list) "true\n")
+ (setq fdo-list (append fdo-list (cons (cons "NoDisplay" "true\n")))))
+ (if (not (assoc "Exec" fdo-list))
+ (setq fdo-list (append fdo-list (cons (cons "Exec" "sawfish-client -c 'display-errors'\n")))))
+ (if (and (not (assoc "Name" fdo-list))
+ (not (assoc (concat fdo-name-string my-lang-string "]") fdo-list)))
+ (setq fdo-list (append fdo-list (cons (cons "Name" "Unknown\n")))))
+ (if (assoc "Categories" fdo-list)
+ (rplacd (assoc "Categories" fdo-list) "Exile\n")
+ (setq fdo-list (append fdo-list (cons (cons "Categories" "Exile\n"))))))
+
+ (define (fdo-check-exile fdo-list)
+ (if fdo-list
+ (if (or (not (assoc "Categories" fdo-list))
+ (not (assoc "Exec" fdo-list))
+ (and (not (assoc "Name" fdo-list))
+ (not (assoc (concat fdo-name-string my-lang-string "]") fdo-list))))
+ (fdo-exile fdo-list)
+ fdo-list)))
+
;; generate a saw-fish menu entry from a .desktop file
- (defun generate-menu-entry (desk-file)
+ (define (generate-menu-entry desk-file)
(if (and (not (file-directory-p desk-file))
(desktop-file-p desk-file))
- (let ((fdo-list (parse-desktop-file desk-file)))
- (if (not (string= (cdr (assoc "NoDisplay" fdo-list)) "true\n"))
+ (let ((fdo-list (fdo-check-exile (parse-desktop-file desk-file))))
+ (if ignore-no-display
+ (if (assoc "NoDisplay" fdo-list)
+ (rplacd (assoc "NoDisplay" fdo-list) "false\n")
+ (setq fdo-list (append fdo-list (cons (cons "NoDisplay" "false\n"))))))
+ (if (not (string= (cdr (assoc "NoDisplay" fdo-list)) "true\n"))
(cons (parse-cat-list (build-cat-list (trim-end (cdr (assoc "Categories" fdo-list)))))
(cons (trim-end (cdr (assoc (find-lang-in-desktop-file fdo-list) fdo-list)))
(if (string= (cdr (assoc "Terminal" fdo-list)) "true\012")
@@ -281,10 +315,12 @@
;; Update the menu
(define (update-saw-menu)
(unless (not use-fdo-menu)
- (setq *loc-menu* nil)
+ (setq *fdo-local-menu* nil)
+ (if (< (length my-lang-string) 2)
+ (setq my-lang-string "xx"))
(let ((desk-files (flatten (map-dir-files desktop-directory))))
(mapc (lambda (x)
- (setq *loc-menu* (append *loc-menu* (list (generate-menu-entry x))))) desk-files)
+ (setq *fdo-local-menu* (append *fdo-local-menu* (list (generate-menu-entry x))))) desk-files)
(if want-alphabetize
(setq apps-menu (alphabetize-entries (fix-cats menu-cat-alist)))
(setq apps-menu (fix-cats menu-cat-alist))))))
--
Matthew Love
[
Date Prev][
Date Next] [
Thread Prev][
Thread Next]
[
Thread Index]
[
Date Index]
[
Author Index]
