One Hat Cyber Team

View File Name : debian-ispell.el

;; File: debian-ispell.el
;; -----------------------------------------------------------------------
;; Description: Emacsen support for Debian package dictionaries-common
;; Authors: Rafael Laboissière <rafael@debian.org>
;;          Agustin Martin     <agmartin@debian.org>
;; Created on: Tue Oct 26 10:16:12 CEST 1999
;; -----------------------------------------------------------------------

(defcustom debian-dict-common-debug nil
  "A lot of debugging info will be shown if non nil."
  :type 'boolean
  :group 'ispell)

(defvar debian-ispell-only-dictionary-alist nil
  "Alist of Debian installed ispell dicts and properties.
Its value will be used to set `ispell-dictionary-alist' after
ispell.el is loaded when ispell is in use.
Do not change this variable directly. It is autogenerated
from data supplied by ispell dictionaries maintainers.")

(defvar debian-aspell-only-dictionary-alist nil
  "Alist of Debian installed aspell dicts and properties.
Its value will be used to set `ispell-dictionary-alist' after
ispell.el is loaded when aspell is in use.
Do not change this variable directly. It is autogenerated
from data supplied by aspell dictionaries maintainers.")

(defvar debian-hunspell-only-dictionary-alist nil
  "Alist of Debian installed hunspell dicts and properties.
Its value will be used to set `ispell-dictionary-alist' after
ispell.el is loaded when hunspell is in use.
Do not change this variable directly. It is autogenerated
from data supplied by hunspell dictionaries maintainers.")

(defvar debian-ispell-valid-dictionary-list nil
  "List of registered ispell, aspell or hunspell dicts.
Will be used to set the dictionaries pop-up menu.")

(defun debian-ispell-add-dictionary-entry (entry &optional name)
  "Obsolete function!!. Entries in ~/.emacs must be adapted to
modify `ispell-local-dictionary-alist'"
  (message "`debian-ispell-add-dictionary-entry': Obsolete function!!.
Entries in ~/.emacs must be adapted to modify `ispell-local-dictionary-alist'.
See dictionaries-common README.emacs")
  )

;;; ----------------------------------------------------------------------
;;;  Handle ispell.el load at startup
;;; ----------------------------------------------------------------------

(defun debian-ispell-build-startup-menu (mylist)
;;; ----------------------------------------------------------------------
;;; Extracted from ispell.el, by Ken Stevens, part of GNU emacs.
;;; Original code released under the GNU GPL license
;;; ----------------------------------------------------------------------
  "Build startup menu, trying to not explicitely load ispell.el"
  (let ((dicts (reverse mylist)))
    (setq ispell-menu-map (make-sparse-keymap "Spell"))
    ;; Define commands in menu in opposite order you want them to appear.

    ;; Add the dictionaries to the bottom of the list.
    (dolist (name dicts)
      (if (string-equal "default" name)
	  (define-key ispell-menu-map (vector 'default)
	    (cons "Select Default Dict"
		  (cons "Dictionary for which Ispell was configured"
			(list 'lambda () '(interactive)
			      (list
			       'ispell-change-dictionary "default")))))
	(define-key ispell-menu-map (vector (intern name))
	  (cons (concat "Select " (capitalize name) " Dict")
		(list 'lambda () '(interactive)
		      (list 'ispell-change-dictionary name)))))))
  ;; -- [ispell-change-dictionary]
  (define-key ispell-menu-map [ispell-change-dictionary]
    '(menu-item "Change Dictionary..." ispell-change-dictionary
   		:help "Supply explicit dictionary file name"))
  ;; -- [ispell-kill-ispell]
  (define-key ispell-menu-map [ispell-kill-ispell]
    '(menu-item "Kill Process"
		(lambda () (interactive) (ispell-kill-ispell nil 'clear))
		:enable (and (boundp 'ispell-process) ispell-process
			     (eq (ispell-process-status) 'run))
		:visible (featurep 'ispell)
		:help "Terminate Ispell subprocess"))
  ;; -- [ispell-pdict-save]
  (define-key ispell-menu-map [ispell-pdict-save]
    '(menu-item "Save Dictionary"
		(lambda () (interactive) (ispell-pdict-save t t))
		:visible (featurep 'ispell)
		:help "Save personal dictionary"))
  ;; -- [ispell-customize]
  (define-key ispell-menu-map [ispell-customize]
    '(menu-item "Customize..."
		(lambda () (interactive) (customize-group 'ispell))
		:help "Customize spell checking options"))
  ;; -- [ispell-help]
  (define-key ispell-menu-map [ispell-help]
    ;; use (x-popup-menu last-nonmenu-event(list "" ispell-help-list)) ?
    '(menu-item "Help"
		(lambda () (interactive) (describe-function 'ispell-help))
		:help "Show standard Ispell keybindings and commands"))
  ;; -- [flyspell-mode]
  (define-key ispell-menu-map [flyspell-mode]
    '(menu-item "Automatic spell checking (Flyspell)"
		flyspell-mode
		:help "Check spelling while you edit the text"
		:button (:toggle . (and (boundp 'flyspell-mode)
					flyspell-mode))))
  ;; -- [ispell-complete-word]
  (define-key ispell-menu-map [ispell-complete-word]
    '(menu-item "Complete Word" ispell-complete-word
		:help "Complete word at cursor using dictionary"))
  ;; -- [ispell-complete-word-interior-frag]
  (define-key ispell-menu-map [ispell-complete-word-interior-frag]
    '(menu-item "Complete Word Fragment" ispell-complete-word-interior-frag
		:help "Complete word fragment at cursor"))
  ;; -- [ispell-continue]
  (define-key ispell-menu-map [ispell-continue]
    '(menu-item "Continue Spell-Checking" ispell-continue
		:enable (and (boundp 'ispell-region-end)
			     (marker-position ispell-region-end)
			     (equal (marker-buffer ispell-region-end)
				    (current-buffer)))
		:visible (featurep 'ispell)
		:help "Continue spell checking last region"))
  ;; -- [ispell-word]
  (define-key ispell-menu-map [ispell-word]
    '(menu-item "Spell-Check Word" ispell-word
		:help "Spell-check word at cursor"))
  ;; -- [ispell-comments-and-strings]
  (define-key ispell-menu-map [ispell-comments-and-strings]
    '(menu-item "Spell-Check Comments" ispell-comments-and-strings
		:help "Spell-check only comments and strings"))
  ;; -- [ispell-region]
  (define-key ispell-menu-map [ispell-region]
    '(menu-item "Spell-Check Region" ispell-region
		:enable mark-active
		:help "Spell-check text in marked region"))
  ;; --  [ispell-message]
  (define-key ispell-menu-map [ispell-message]
    '(menu-item "Spell-Check Message" ispell-message
		:visible (eq major-mode 'mail-mode)
		:help "Skip headers and included message text"))
  ;; -- [ispell-buffer]
  (define-key ispell-menu-map [ispell-buffer]
    '(menu-item "Spell-Check Buffer" ispell-buffer
		:help "Check spelling of selected buffer"))
  ;;(put 'ispell-region 'menu-enable 'mark-active)
  (fset 'ispell-menu-map (symbol-value 'ispell-menu-map))

  (if (and (featurep 'xemacs)
   	   (featurep 'menubar)
   	   ;;(null ispell-menu-xemacs)
   	   (not (and (boundp 'infodock-version) infodock-version)))
      (let ((dicts mylist)
   	    (current-menubar (or current-menubar default-menubar))
   	    (menu
   	     '(["Help"		(describe-function 'ispell-help) t]
   	       ;;["Help"		(popup-menu ispell-help-list)	t]
   	       ["Check Message"       ispell-message (eq major-mode 'mail-mode)]
   	       ["Check Buffer"	      ispell-buffer			    t]
   	       ["Check Comments"      ispell-comments-and-strings	    t]
   	       ["Check Word"	      ispell-word			    t]
   	       ["Check Region"	      ispell-region  (or (not zmacs-regions) (mark))]
   	       ["Continue Check"      ispell-continue	      (featurep 'ispell)]
	       ["Complete Word Frag"  ispell-complete-word-interior-frag   t]
  	       ["Complete Word"       ispell-complete-word		    t]
   	       ["Kill Process"	      (ispell-kill-ispell nil 'clear) (featurep 'ispell)]
   	       ["Customize..."	      (customize-group 'ispell)	    t]
   	       ;; flyspell-mode may not be bound...
   	       ["flyspell"	      flyspell-mode
   		:style toggle
   		:selected (and (boundp 'flyspell-mode)
   			       flyspell-mode)
   		:active (boundp 'flyspell-mode)]
   	       "-"
   	       ["Save Personal Dict"  (ispell-pdict-save t t) (featurep 'ispell)]
   	       ["Change Dictionary"   ispell-change-dictionary	t])))
   	(if (null dicts)
   	    (setq dicts (cons "default" nil)))
   	(dolist (name dicts)
   	  (setq menu (append menu
   			     (list
   			      (vector
   			       (concat "Select " (capitalize name))
   			       (list 'ispell-change-dictionary name)
   			       t)))))
   	(setq ispell-menu-xemacs menu)
   	(if current-menubar
   	    (progn
   	      (if (car (find-menu-item current-menubar '("Cmds")))
   		  (progn
   		    ;; XEmacs 21.2
   		    (delete-menu-item '("Cmds" "Spell-Check"))
   		    (add-menu '("Cmds") "Spell-Check" ispell-menu-xemacs))
   		;; previous
   		(delete-menu-item '("Edit" "Spell")) ; in case already defined
   		(add-menu '("Edit") "Spell" ispell-menu-xemacs))))))
  )

(defun debian-ispell-set-startup-menu (&optional force)
  "Make sure ispell startup menu is ready after startup.
To be run at `after-init-hook' or at any time if FORCE is given."
  ;; I know let* is cleaner, but this helps debugging
  (let (really-aspell
	really hunspell
	debian-valid-dictionary-list
	dicts-list)

    ;; Check for spellchecker engine
    (or (setq really-aspell
	      (if (boundp 'ispell-really-aspell)
		  ispell-really-aspell
		(and (boundp 'ispell-program-name)
		     (string-match "aspell" ispell-program-name)
		     t)))
	(setq really-hunspell
	      (if (boundp 'ispell-really-hunspell)
		  ispell-really-hunspell
		(and (boundp 'ispell-program-name)
		     (string-match "hunspell" ispell-program-name)
		     t))))

    ;; Get list of registered for given spellchecker
    (setq debian-valid-dictionary-list
	  (if really-aspell
	      (mapcar 'car debian-aspell-only-dictionary-alist)
	    (if really-hunspell
		(mapcar 'car debian-hunspell-only-dictionary-alist)
	      (mapcar 'car debian-ispell-only-dictionary-alist))))

    ;; Get full list of dicts to be displayed in the menu
    (setq dicts-list
	  (if (boundp 'ispell-local-dictionary-alist)
	      (append (mapcar 'car ispell-local-dictionary-alist)
		      debian-valid-dictionary-list)
	    debian-valid-dictionary-list))

    (if (and (featurep 'ispell)
	     (not force))
	nil
      (when (fboundp 'debian-ispell-build-startup-menu)
	(debian-ispell-build-startup-menu dicts-list)
	;; (fmakunbound 'debian-ispell-build-startup-menu)
	))))

;; Make sure updated Debian menu is available after emacs is started
(add-hook 'after-init-hook 'debian-ispell-set-startup-menu)

;; Make sure updated Debian menu is not overriden by ispell.el one
(eval-after-load "ispell" '(debian-ispell-set-startup-menu))

;;; -----------------------------------------------------------------------
;;;  Guess default ispell dictionary under emacs and make ispell.el use it
;;; -----------------------------------------------------------------------

(defvar debian-ispell-dictionary
  nil
  "The name of the ispell dictionary that will become the default after
loading of ispell.el.")

;; ---------------------------------------------------------------------------
;; Load the file containing the default value for debian-ispell-dictionary
;; ---------------------------------------------------------------------------

(if (file-exists-p "/var/cache/dictionaries-common/emacsen-ispell-default.el")
    (load "/var/cache/dictionaries-common/emacsen-ispell-default.el"))

;;; ----------------

(defvar debian-aspell-dictionary
  nil
  "The name of the aspell dictionary that will become the default after
loading of ispell.el.")

(defvar debian-hunspell-dictionary
  nil
  "The name of the hunspell dictionary that will become the default after
loading of ispell.el.")

(defvar debian-aspell-equivs-alist
  '((nil . nil))
  "Alist of equivalences between locales and aspell dictionaries,
used internally by the debian ispell.el initialization scheme.
Do not change this variable directly. It is autogenerated
from data supplied by aspell dictionaries maintainers.")

(defvar debian-hunspell-equivs-alist
  '((nil . nil))
  "Alist of equivalences between locales and hunspell dictionaries,
used internally by the debian ispell.el initialization scheme.
Do not change this variable directly. It is autogenerated
from data supplied by hunspell dictionaries maintainers.")

;; ---------------------------------------------------------------------------
;; Guess emacsen entry for aspell and hunspell after locale provided by aspell
;; or after environment variables LC_ALL and LANG for hunspell
;; Intended to be called from /var/cache/emacsen-ispell-dicts.el
;; to set debian-{a,huns}spell-dictionary if possible
;; ---------------------------------------------------------------------------

(defun debian-ispell-try-lang-equiv (langstring equivs-alist)
  "Try finding a LANGSTRING match in EQUIVS-ALIST.
EQUIVS-ALIST is an assoc list of locales vs dict names."
  (let ((prefixes  '("" "1:"))
	(suffixes  '("^" "@" "." "_"))
	(langmatch '(nil nil)))

    (if langstring
	(catch 'tag
	  (dolist (lang (split-string langstring ":"))
	    (dolist (suffix suffixes)
	      (dolist (prefix prefixes)
		(if (setq langmatch
			  (cdr (assoc (concat prefix
					      (car (split-string lang suffix)))
				      equivs-alist)))
		    (throw 'tag (car langmatch))))))))))


(defun debian-ispell-get-aspell-default ()
  "Get default dictionary for aspell.
Ask aspell about the default dictionary it will use, and
try finding a match for it in `debian-aspell-equivs-alist'
alist provided by registered dicts."
  (let ((lang (condition-case ()
		  (with-temp-buffer
		    (call-process "aspell" nil t nil "config" "lang")
		    (car (split-string (buffer-string))))
		(error nil))))

    (debian-ispell-try-lang-equiv lang debian-aspell-equivs-alist)))

(defun debian-ispell-get-hunspell-default ()
  "Get default dictionary for hunspell under XEmacs.
Look at the `debian-aspell-equivs-alist' alist provided by registered
dicts to try finding a match for \"LC_ALL\" or \"LANG\".
Emacs will rely on hunspell dicts auto-detection."
  (if (featurep 'xemacs)
      (or (debian-ispell-try-lang-equiv (getenv "LC_ALL") debian-hunspell-equivs-alist)
	  (debian-ispell-try-lang-equiv (getenv "LANG")   debian-hunspell-equivs-alist))))

;; ---------------------------------------------------------------------------
;; Make sure otherchars are read as chars in proper encoding. ispell.el may
;; change later casechars and not-casechars to 'utf8 and we need to do this.
;; This function will be called from (debian-ispell-initialize-dicts-alist),
;; run from 'ispell-initialize-spellchecker-hook. We cannot do the filtering
;; from this file, on startup it is read before dictionaries alists.
;; ---------------------------------------------------------------------------
(defun debian-ispell-preprocess-dicts-alist (dicts-alist)
  (let (tmp-dicts-alist)
    (dolist (adict dicts-alist)
      (add-to-list 'tmp-dicts-alist
		   (list
		    (nth 0 adict)  ; dict name
		    (nth 1 adict)  ; casechars
		    (nth 2 adict)  ; not-casechars
		    (decode-coding-string (nth 3 adict) (nth 7 adict)) ; otherchars
		    (nth 4 adict)  ; many-otherchars-p
		    (nth 5 adict)  ; ispell-args
		    (nth 6 adict)  ; extended-character-mode
		    (nth 7 adict))))
    tmp-dicts-alist))

;; ---------------------------------------------------------------------------
;; Make sure the correct installed dicts alist is used for each spellchecker
;; This hook will be run after each change in `ispell-program-name'
;; ---------------------------------------------------------------------------

(defun debian-ispell-initialize-dicts-alist ()
  (let ((really-aspell
	 (or (and (boundp 'ispell-really-aspell)
		  ispell-really-aspell)
	     nil))

	(really-hunspell
	 (or (and (boundp 'ispell-really-hunspell)
		  ispell-really-hunspell)
	     nil)))

    (when debian-dict-common-debug
      (message "- (debian-ispell-initialize-dicts-alist) from (ispell-set-spellchecker-params) hook:
   ispell-program-name: %s
   DID:%s, DAD:%s, DHD: %s, RA:%s, RH: %s, ILD: %s, ID: %s"
	       ispell-program-name
	       debian-ispell-dictionary
	       debian-aspell-dictionary
	       debian-hunspell-dictionary
	       really-aspell
	       really-hunspell
	       ispell-local-dictionary
	       ispell-dictionary))

    (setq ispell-base-dicts-override-alist
	  (debian-ispell-preprocess-dicts-alist
	   (if really-aspell
	       debian-aspell-only-dictionary-alist
	     (if really-hunspell
		 debian-hunspell-only-dictionary-alist
	       debian-ispell-only-dictionary-alist))))
    (setq debian-ispell-valid-dictionary-list
	  (mapcar 'car ispell-base-dicts-override-alist))
    (debian-ispell-set-startup-menu 'force)))

(add-hook 'ispell-initialize-spellchecker-hook 'debian-ispell-initialize-dicts-alist)

;; ---------------------------------------------------------------------------
;; Set `ispell-dictionary' to Debian default dict for given
;; spellchecker, unless it has already been customized or set in any
;; other way.
;; This function is added to `after-init-hook', so it is evaluated
;; right after init files loading with actual `ispell-program-name',
;; but before ispell.el.
;; ---------------------------------------------------------------------------
(defun debian-ispell-set-default-dictionary ()
  "Set ispell default to the debconf selected one if ispell-program-name is
ispell or, when ispell-program-name is aspell, to the value guessed after
LANG if any."
  (let* ((really-aspell
	  (if (boundp 'ispell-really-aspell)
	      ispell-really-aspell
	    (and (boundp 'ispell-program-name)
		 (string-match "aspell" ispell-program-name)
		 t)))
	 (really-hunspell
	  (if (boundp 'ispell-really-hunspell)
	      ispell-really-hunspell
	    (and (boundp 'ispell-program-name)
		 (string-match "hunspell" ispell-program-name)
		 t)))
	 (default-dictionary
	   (if really-aspell
	       debian-aspell-dictionary
	     (if really-hunspell
		debian-hunspell-dictionary
	       debian-ispell-dictionary))))

    ;; Set `ispell-dictionary' if still unbound. This will be done after
    ;; init files load, with real `ispell-program-name'
    (or ispell-dictionary
	(customize-set-variable 'ispell-dictionary default-dictionary))

    ;; The debugging output if required
    (if debian-dict-common-debug
	(message "- (debian-ispell-set-default-dictionary ):
   DID:%s, DAD:%s, DHD: %s, RA:%s, RH: %s, DD:%s, ID:%s, IPN:%s"
		 debian-ispell-dictionary
		 debian-aspell-dictionary
		 debian-hunspell-dictionary
		 really-aspell
		 really-hunspell
		 default-dictionary
		 ispell-dictionary
		 ispell-program-name))
    )) ;; let and defun ends
(add-hook 'after-init-hook 'debian-ispell-set-default-dictionary)

;; ---------------------------------------------------------------------------
;; Make sure patched ispell.el is first in the loadpath if not already there
;; ---------------------------------------------------------------------------

(when (fboundp 'debian-pkg-add-load-path-item)
  (let ((mypath (concat "/usr/share/"
			(symbol-name debian-emacs-flavor)
			"/site-lisp/dictionaries-common")))
    (unless (member mypath load-path)
      (debian-pkg-add-load-path-item mypath))))

;; --------------------------------------------------------------------------
;; Set ispell-program-name consistently for all emacsen flavours. Prefer
;; aspell over ispell as has been for some time in FSF Emacs. Leave hunspell
;; as last option, hunspell support for -a is still too buggy.
;; --------------------------------------------------------------------------

(defcustom ispell-program-name
  (if (executable-find "aspell")
      "aspell"
    (if (executable-find "ispell")
	"ispell"
      (if (executable-find "hunspell")
	  "hunspell"
	"ispell")))
  "Program invoked by \\[ispell-word] and \\[ispell-region] commands."
  :type 'string
  :set (lambda (symbol value)
         (set-default symbol value)
         (if (featurep 'ispell)
             (ispell-set-spellchecker-params)))
  :group 'ispell)


(defcustom ispell-dictionary nil
  "Default dictionary to use if `ispell-local-dictionary' is nil."
  :type '(choice string
		 (const :tag "default" nil))
  :group 'ispell)

;;; -----------------------------------------------------------------------