home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / share / emacs / site-lisp / dictionaries-common / debian-ispell.el next >
Encoding:
Text File  |  2006-07-12  |  15.0 KB  |  408 lines
  1. ;;File: debian-ispell.el
  2. ;;; -----------------------------------------------------------------------
  3. ;;;    $Id: debian-ispell.el,v 1.26 2006/03/13 18:27:48 agmartin Exp $    
  4. ;;; -----------------------------------------------------------------------
  5. ;;Description: Emacsen support for Debian package dictionaries-common
  6. ;;Authors: Rafael LaboissiΦre <rafael@debian.org>
  7. ;;         Agustin Martin     <agmartin@debian.org>
  8. ;;Created on: Tue Oct 26 10:16:12 CEST 1999
  9. ;;; -----------------------------------------------------------------------
  10.  
  11. (defcustom debian-dict-common-debug nil
  12.   "A lot of debugging info will be shown if non nil."
  13.   :type 'boolean
  14.   :group 'ispell)
  15.  
  16. ;;; -----------------------------------------------------------------------
  17. ;;;  Initialize the alist containing all info for the different spell
  18. ;;;  emacsen entries and provide the function to populate it
  19. ;;; -----------------------------------------------------------------------
  20.  
  21. (defvar debian-ispell-dictionary-alist 
  22.   '((nil "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B") nil iso-8859-1))
  23.   "Alist of dictionaries used internally by the Debian ispell
  24. initialization scheme.  Its value will be used to set
  25. `ispell-dictionary-alist' after ispell.el is loaded.
  26.  
  27. Do not change this variable directly.  Use the
  28. `debian-ispell-add-dictionary-entry' function instead.")
  29.  
  30. (defvar debian-ispell-valid-dictionary-list nil
  31.   "A list that will contain the list of emacsen names provided by
  32. registered ispell or aspell dicts")
  33.  
  34. (defvar debian-ispell-availability-alist
  35.   '((nil . nil))
  36.   "A list that will contain a mappping of emacsen names vs the
  37. spellchecker for which they are available. Its value will be
  38. filled by the debian-ispell-add-dictionary-entry function")
  39.  
  40. (defun debian-ispell-add-dictionary-entry (entry &optional name)
  41.   "Adds an ENTRY to the ispell-dictionary-alist variable. See the 
  42. documentation of the variable ispell-dictionary-alist for the format 
  43. of ENTRY. NAME can be ispell, aspell or all, depending on the
  44. available spellchecker(s) for that entry"
  45.   (set-variable 'debian-ispell-dictionary-alist
  46.         (append (list entry) debian-ispell-dictionary-alist))
  47.   (set-variable 'debian-ispell-valid-dictionary-list
  48.         (add-to-list 'debian-ispell-valid-dictionary-list (car entry)))
  49.   (if name
  50.       (set-variable 'debian-ispell-availability-alist
  51.             (append (list (cons (car entry) name))
  52.                 debian-ispell-availability-alist)))
  53.   )
  54.  
  55. ;;; ----------------------------------------------------------------------
  56. ;;;  Handle ispell.el load at startup
  57. ;;; ----------------------------------------------------------------------
  58.  
  59. (defun debian-ispell-build-startup-menu ()
  60. ;;; ----------------------------------------------------------------------
  61. ;;; Extracted from ispell.el, by Ken Stevens, part of GNU emacs.
  62. ;;; Original code released under the GNU GPL license
  63. ;;; ----------------------------------------------------------------------
  64.   "Build startup menu, trying to not explicitely load ispell.el"
  65.   (if ispell-menu-map-needed
  66.       (let ((dicts (reverse mylist)))
  67.     (setq ispell-menu-map (make-sparse-keymap "Spell"))
  68.     ;; add the dictionaries to the bottom of the list.
  69.     (while dicts
  70.       (if (string-equal "default" (car dicts))
  71.           (define-key ispell-menu-map (vector 'default)
  72.         (cons "Select Default Dict"
  73.               (cons "Dictionary for which Ispell was configured"
  74.                 (list 'lambda () '(interactive)
  75.                   (list
  76.                    'ispell-change-dictionary "default")))))
  77.         (define-key ispell-menu-map (vector (intern (car dicts)))
  78.           (cons (concat "Select " (capitalize (car dicts)) " Dict")
  79.             (list 'lambda () '(interactive)
  80.               (list 'ispell-change-dictionary (car dicts))))))
  81.       (setq dicts (cdr dicts)))))
  82.   
  83.   (if ispell-menu-map-needed
  84.       (progn
  85.     (define-key ispell-menu-map [ispell-change-dictionary]
  86.       '(menu-item "Change Dictionary..." ispell-change-dictionary
  87.               :help "Supply explicit dictionary file name"))
  88.     ;; --
  89.     ;; (define-key ispell-menu-map [ispell-kill-ispell]
  90.     ;;   '(menu-item "Kill Process" ispell-kill-ispell
  91.     ;;           :enable (and (boundp 'ispell-process) ispell-process
  92.     ;;                (eq (ispell-process-status) 'run))
  93.     ;;           :help "Terminate Ispell subprocess"))
  94.     ;; --
  95.     ;; (define-key ispell-menu-map [ispell-pdict-save]
  96.     ;;   '(menu-item "Save Dictionary"
  97.     ;;           (lambda () (interactive) (ispell-pdict-save t t))
  98.     ;;           :help "Save personal dictionary"))
  99.     ;; --
  100.     (define-key ispell-menu-map [ispell-customize]
  101.       '(menu-item "Customize..."
  102.               (lambda () (interactive) (customize-group 'ispell))
  103.               :help "Customize spell checking options"))
  104.     ;; --
  105.     (define-key ispell-menu-map [ispell-help]
  106.       ;; use (x-popup-menu last-nonmenu-event(list "" ispell-help-list)) ?
  107.       '(menu-item "Help"
  108.               (lambda () (interactive) (describe-function 'ispell-help))
  109.               :help "Show standard Ispell keybindings and commands"))
  110.     ;; --
  111.     (define-key ispell-menu-map [flyspell-mode]
  112.       '(menu-item "Automatic spell checking (Flyspell)"
  113.               flyspell-mode
  114.               :help "Check spelling while you edit the text"
  115.               :button (:toggle . (and (boundp 'flyspell-mode)
  116.                           flyspell-mode))))
  117.     ;; --
  118.     (define-key ispell-menu-map [ispell-complete-word]
  119.       '(menu-item "Complete Word" ispell-complete-word
  120.               :help "Complete word at cursor using dictionary"))
  121.     ;; --
  122.     (define-key ispell-menu-map [ispell-complete-word-interior-frag]
  123.       '(menu-item "Complete Word Fragment" ispell-complete-word-interior-frag
  124.               :help "Complete word fragment at cursor"))))
  125.   
  126.   (if ispell-menu-map-needed
  127.       (progn
  128.     ;; (define-key ispell-menu-map [ispell-continue]
  129.     ;;   '(menu-item "Continue Spell-Checking" ispell-continue
  130.     ;;           :enable (and (boundp 'ispell-region-end)
  131.     ;;              (marker-position ispell-region-end)
  132.     ;;              (equal (marker-buffer ispell-region-end)
  133.     ;;                 (current-buffer)))
  134.     ;;           :help "Continue spell checking last region"))
  135.     ;; --
  136.     (define-key ispell-menu-map [ispell-word]
  137.       '(menu-item "Spell-Check Word" ispell-word
  138.               :help "Spell-check word at cursor"))
  139.     ;; --
  140.     (define-key ispell-menu-map [ispell-comments-and-strings]
  141.       '(menu-item "Spell-Check Comments" ispell-comments-and-strings
  142.               :help "Spell-check only comments and strings"))))
  143.   
  144.   
  145.   (if ispell-menu-map-needed
  146.       (progn
  147.     (define-key ispell-menu-map [ispell-region]
  148.       '(menu-item "Spell-Check Region" ispell-region
  149.               :enable mark-active
  150.               :help "Spell-check text in marked region"))
  151.     (define-key ispell-menu-map [ispell-message]
  152.       '(menu-item "Spell-Check Message" ispell-message
  153.               :visible (eq major-mode 'mail-mode)
  154.               :help "Skip headers and included message text"))
  155.     (define-key ispell-menu-map [ispell-buffer]
  156.       '(menu-item "Spell-Check Buffer" ispell-buffer
  157.               :help "Check spelling of selected buffer"))
  158.     ;;(put 'ispell-region 'menu-enable 'mark-active)
  159.     (fset 'ispell-menu-map (symbol-value 'ispell-menu-map))))
  160.   
  161.   (if (and (featurep 'xemacs)
  162.        (featurep 'menubar)
  163.        ;;(null ispell-menu-xemacs)
  164.        (not (and (boundp 'infodock-version) infodock-version)))
  165.       (let ((dicts mylist)
  166.         (current-menubar (or current-menubar default-menubar))
  167.         (menu
  168.          '(["Help"        (describe-function 'ispell-help) t]
  169.         ;;["Help"        (popup-menu ispell-help-list)    t]
  170.         ["Check Message" ispell-message (eq major-mode 'mail-mode)]
  171.         ["Check Buffer"    ispell-buffer            t]
  172.         ["Check Comments"    ispell-comments-and-strings    t]
  173.         ["Check Word"    ispell-word            t]
  174.         ["Check Region"    ispell-region  (or (not zmacs-regions) (mark))]
  175.         ;; ["Continue Check"    ispell-continue            t]
  176.         ["Complete Word Frag"ispell-complete-word-interior-frag t]
  177.         ["Complete Word"    ispell-complete-word        t]
  178.         ;; ["Kill Process"    ispell-kill-ispell        t]
  179.         ["Customize..."    (customize-group 'ispell)    t]
  180.         ;; flyspell-mode may not be bound...
  181.         ["flyspell"    flyspell-mode
  182.         :style toggle :selected flyspell-mode ]
  183.         "-"
  184.         ;; ["Save Personal Dict"(ispell-pdict-save t t)    t]
  185.         ["Change Dictionary" ispell-change-dictionary    t])))
  186.     (if (null dicts)
  187.         (setq dicts (cons "default" nil)))
  188.     (dolist (name dicts)
  189.       (setq menu (append menu
  190.                  (list
  191.                   (vector
  192.                    (concat "Select " (capitalize name))
  193.                    (list 'ispell-change-dictionary name)
  194.                    t)))))
  195.     (setq ispell-menu-xemacs menu)
  196.     (if current-menubar
  197.         (progn
  198.           (if (car (find-menu-item current-menubar '("Cmds")))
  199.           (progn
  200.             ;; XEmacs 21.2
  201.             (delete-menu-item '("Cmds" "Spell-Check"))
  202.             (add-menu '("Cmds") "Spell-Check" ispell-menu-xemacs))
  203.           ;; previous
  204.         (delete-menu-item '("Edit" "Spell")) ; in case already defined
  205.         (add-menu '("Edit") "Spell" ispell-menu-xemacs))))))
  206.   
  207.   )
  208.  
  209. (defun debian-ispell-set-startup-menu ()
  210.   "Make sure ispell startup menu is ready after startup.
  211. To be run at 'after-init-hook"
  212.   (let ((mylist (append (mapcar 'car ispell-local-dictionary-alist)
  213.             debian-ispell-valid-dictionary-list)))
  214.     (if (featurep 'ispell)
  215.     (message "ispell.el is already loaded")
  216.       (when (fboundp 'debian-ispell-build-startup-menu)
  217.     (debian-ispell-build-startup-menu)
  218.     (fmakunbound 'debian-ispell-build-startup-menu)
  219.     ))))
  220.   
  221. (add-hook 'after-init-hook 'debian-ispell-set-startup-menu)
  222.  
  223. ;;; -----------------------------------------------------------------------
  224. ;;;  Guess default ispell dictionary under emacs and make ispell.el use it
  225. ;;; -----------------------------------------------------------------------
  226.  
  227. (defvar debian-ispell-dictionary 
  228.   nil
  229.   "The name of the ispell dictionary that will become the default after
  230. loading of ispell.el.")
  231.  
  232. ;; Load the file containing the default value for debian-ispell-dictionary
  233.  
  234. (if (file-exists-p "/var/cache/dictionaries-common/emacsen-ispell-default.el")
  235.     (load "/var/cache/dictionaries-common/emacsen-ispell-default.el"))
  236.  
  237. ;;; ----------------
  238.  
  239. (defvar debian-aspell-dictionary 
  240.   nil
  241.   "The name of the aspell dictionary that will become the default after
  242. loading of ispell.el.")
  243.  
  244. (defvar debian-aspell-equivs-alist 
  245.   '((nil . nil))
  246.   "Alist of equivalences between locales and aspell dictionaries,
  247. used internally by the debian ispell.el initialization scheme.
  248. Do not change this variable directly. It is autogenerated 
  249. from data supplied by aspell dictionaries maintainers")
  250.  
  251. ;;; -------------
  252. ;;; Guess emacsen entry for aspell after LANG or other envvar
  253. ;;; Intended to be called from /var/cache/emacsen-ispell-dicts.el
  254. ;;; to set debian-aspell-dictionary if possible
  255. ;;; ---------------
  256.  
  257. (defun debian-get-aspell-default ()
  258.   "Guess emacsen entry associated to the given aspell lang option
  259. value. Will try calling <aspell config lang> for this and return
  260. nil in case of error or no match be found"
  261.   (let (prefixes
  262.     (suffixes '("^" "@" "_"))
  263.     debian-aspell-default
  264.     (lang (condition-case ()
  265.           (with-temp-buffer
  266.             (call-process "aspell" nil t nil "config" "lang")
  267.             (car (split-string (buffer-string))))
  268.         (error nil))))
  269.     ;; (message "aspell-lang: %s" lang)
  270.     (if lang
  271.     (progn
  272.       (setq lang (car (split-string lang ":")))
  273.       (catch 'tag
  274.         (while suffixes
  275.           (setq prefixes '("" "1:"))
  276.           (while prefixes
  277.         (if (setq debian-aspell-default
  278.               (cdr (assoc (concat (car prefixes) 
  279.                           (car (split-string lang (car suffixes))))
  280.                       debian-aspell-equivs-alist)))
  281.             (throw 'tag (car debian-aspell-default)))
  282.         ;;
  283.         (setq prefixes (cdr prefixes))
  284.         )
  285.           (setq suffixes (cdr suffixes))
  286.           )
  287.         ))
  288.       nil)
  289.     )
  290.   )
  291.  
  292. ;;; --------------
  293.  
  294. ;;; Autoselection is currently unused, so no need to have this as a real defcustom
  295.  
  296. ;;; (defcustom debian-ispell-program-name-noauto nil
  297. ;;;   "*Do not try to guess spellchecker after values registered by 
  298. ;;; Debian dict packages and user settings"
  299. ;;;   :type 'boolean
  300. ;;;   :group 'ispell)
  301.  
  302. (if (not (boundp 'debian-ispell-program-name-noauto))
  303.     (setq debian-ispell-program-name-noauto nil))
  304.  
  305. (defun debian-set-ispell-dictionary ()
  306.   "Set ispell default to the debconf selected one if ispell-program-name is
  307. ispell or, when ispell-program-name is aspell, to the value guessed after
  308. LANG if any."
  309.   (let (debian-ispell-prefer-aspell guessed-ispell-program-name)
  310.     
  311.     ; Set debian-ispell-prefer-aspell 
  312.     
  313.     (setq debian-ispell-prefer-aspell
  314.       (if (or (string-equal ispell-program-name "aspell")
  315.           (and (boundp 'ispell-prefer-aspell)
  316.                ispell-prefer-aspell))
  317.           t
  318.         nil))
  319.  
  320.     ; Set value of ispell-local-dictionary if nil.
  321.     
  322. ;;; (if (not ispell-local-dictionary)
  323. ;;;    (if (and debian-ispell-prefer-aspell debian-aspell-dictionary)
  324. ;;;        (setq ispell-local-dictionary debian-aspell-dictionary)
  325. ;;;      (if debian-ispell-dictionary
  326. ;;;          (setq ispell-local-dictionary debian-ispell-dictionary)))) 
  327.     
  328.     (if (not ispell-local-dictionary)
  329.     (if debian-ispell-prefer-aspell
  330.         (if debian-aspell-dictionary
  331.         (setq ispell-local-dictionary debian-aspell-dictionary))
  332.       (if debian-ispell-dictionary
  333.           (setq ispell-local-dictionary debian-ispell-dictionary))))
  334.     
  335.     ; Look into the spellcheckers availability alist for that dictionary
  336.  
  337.     (setq guessed-ispell-program-name
  338.       (cdr (assoc ispell-local-dictionary debian-ispell-availability-alist)))
  339.     
  340.     (setq debian-ispell-program-name
  341.       (if (or debian-ispell-program-name-noauto
  342.           (not guessed-ispell-program-name))
  343.           ispell-program-name
  344.         (if (string-equal guessed-ispell-program-name "all")
  345.         (if debian-ispell-prefer-aspell
  346.             "aspell"
  347.           "ispell")
  348.           guessed-ispell-program-name)))
  349.     
  350.     ; The debugging output if required
  351.     
  352.     (if debian-dict-common-debug
  353.     (message "- dictionaries DID:%s, DAD:%s, DIPA:%s, ILD:%s, IPN:%s, DIPN:%s" 
  354.          debian-ispell-dictionary 
  355.          debian-aspell-dictionary
  356.          debian-ispell-prefer-aspell
  357.          ispell-local-dictionary
  358.          ispell-program-name
  359.          debian-ispell-program-name))
  360.     )) ;; let and defun ends
  361.  
  362. ;;; ---------------------------------------------------------------------------
  363. ;;;   Make sure patched ispell.el is first in the loadpath if not already there
  364. ;;; ---------------------------------------------------------------------------
  365.  
  366. (let ((mypath (concat "/usr/share/" 
  367.               (symbol-name debian-emacs-flavor) 
  368.               "/site-lisp/dictionaries-common")))
  369.   (unless (member mypath load-path)
  370.     (debian-pkg-add-load-path-item mypath)))
  371.  
  372. ;;; --------------------------------------------------------------------------
  373. ;;; A home made exec-installed-p to test for {i,a}spell executable existence
  374. ;;; Implemented here to avoid apel dependency. Will be nulled at the end
  375. ;;; --------------------------------------------------------------------------
  376.  
  377. (defun debiandc-exec-installed-p (infile)
  378.   "Checking for an executable file in the exec-path. 
  379. Implemented here to avoid apel dependency. This is much much simpler,
  380. we do not need all that apel's portability. Internal use funcion."
  381.   (let (file paths)
  382.     (setq paths exec-path)
  383.     (catch 'tag
  384.       (while paths
  385.     (setq file (expand-file-name infile (car paths)))
  386.     (if (file-executable-p file)
  387.         (throw 'tag t)
  388.       )
  389.     (setq paths (cdr paths))
  390.     )
  391.       )
  392.     )
  393.   )
  394.  
  395. ;; Fallback to aspell if ispell is not present.
  396. ;; Will be overriden by ~/.emacs selection if present
  397.  
  398. (if (not (debiandc-exec-installed-p "ispell"))
  399.     (setq ispell-program-name "aspell"))
  400.  
  401. (fmakunbound 'debiandc-exec-installed-p)
  402.  
  403. ;;; -----------------------------------------------------------------------
  404.  
  405. ;; Local Variables:
  406. ;; mode: lisp
  407. ;; End:
  408.