Mercurial > hg > xemacs-beta
comparison lisp/abbrev.el @ 3965:69c43a181729
[xemacs-hg @ 2007-05-19 18:41:56 by adrian]
| author | adrian |
|---|---|
| date | Sat, 19 May 2007 18:42:17 +0000 |
| parents | a634e3b7acc8 |
| children | 7147a4dabc02 |
comparison
equal
deleted
inserted
replaced
| 3964:a4917b3c97cc | 3965:69c43a181729 |
|---|---|
| 85 (let ((table (and (boundp table-name) (symbol-value table-name)))) | 85 (let ((table (and (boundp table-name) (symbol-value table-name)))) |
| 86 (cond ((vectorp table)) | 86 (cond ((vectorp table)) |
| 87 ((not table) | 87 ((not table) |
| 88 (setq table (make-abbrev-table)) | 88 (setq table (make-abbrev-table)) |
| 89 (set table-name table) | 89 (set table-name table) |
| 90 (setq abbrev-table-name-list (cons table-name abbrev-table-name-list))) | 90 (setq abbrev-table-name-list |
| 91 (sort (cons table-name abbrev-table-name-list) | |
| 92 #'string-lessp))) | |
| 91 (t | 93 (t |
| 92 (setq table (wrong-type-argument 'vectorp table)) | 94 (setq table (wrong-type-argument 'vectorp table)) |
| 93 (set table-name table))) | 95 (set table-name table))) |
| 94 (while definitions | 96 (while definitions |
| 95 (apply (function define-abbrev) table (car definitions)) | 97 (apply (function define-abbrev) table (car definitions)) |
| 207 (if (< last-abbrev-location opoint) | 209 (if (< last-abbrev-location opoint) |
| 208 (goto-char (- opoint adjust)) | 210 (goto-char (- opoint adjust)) |
| 209 (goto-char opoint))))) | 211 (goto-char opoint))))) |
| 210 | 212 |
| 211 | 213 |
| 212 | 214 ; APA: Moved to c (ported function from GNU Emacs to src/abbrev.c) |
| 213 (defun insert-abbrev-table-description (name &optional human-readable) | 215 ; (defun insert-abbrev-table-description (name &optional human-readable) |
| 214 "Insert before point a full description of abbrev table named NAME. | 216 ; "Insert before point a full description of abbrev table named NAME. |
| 215 NAME is a symbol whose value is an abbrev table. | 217 ; NAME is a symbol whose value is an abbrev table. |
| 216 If optional second argument HUMAN-READABLE is non-nil, insert a | 218 ; If optional second argument HUMAN-READABLE is non-nil, insert a |
| 217 human-readable description. Otherwise the description is an | 219 ; human-readable description. Otherwise the description is an |
| 218 expression, a call to `define-abbrev-table', which would define the | 220 ; expression, a call to `define-abbrev-table', which would define the |
| 219 abbrev table NAME exactly as it is currently defined." | 221 ; abbrev table NAME exactly as it is currently defined." |
| 220 (let ((table (symbol-value name)) | 222 ; (let ((table (symbol-value name)) |
| 221 (stream (current-buffer))) | 223 ; (stream (current-buffer))) |
| 222 (message "Abbrev-table %s..." name) | 224 ; (message "Abbrev-table %s..." name) |
| 223 (if human-readable | 225 ; (if human-readable |
| 224 (progn | 226 ; (progn |
| 225 (prin1 (list name) stream) | 227 ; (prin1 (list name) stream) |
| 226 ;; Need two terpri's or cretinous edit-abbrevs blows out | 228 ; ;; Need two terpri's or cretinous edit-abbrevs blows out |
| 227 (terpri stream) | 229 ; (terpri stream) |
| 228 (terpri stream) | 230 ; (terpri stream) |
| 229 (mapatoms (function (lambda (sym) | 231 ; (mapatoms (function (lambda (sym) |
| 230 (if (symbol-value sym) | 232 ; (if (symbol-value sym) |
| 231 (let* ((n (prin1-to-string (symbol-name sym))) | 233 ; (let* ((n (prin1-to-string (symbol-name sym))) |
| 232 (pos (length n))) | 234 ; (pos (length n))) |
| 233 (princ n stream) | 235 ; (princ n stream) |
| 234 (while (< pos 14) | 236 ; (while (< pos 14) |
| 235 (write-char ?\ stream) | 237 ; (write-char ?\ stream) |
| 236 (setq pos (1+ pos))) | 238 ; (setq pos (1+ pos))) |
| 237 (princ (format " %-5S " (symbol-plist sym)) | 239 ; (princ (format " %-5S " (symbol-plist sym)) |
| 238 stream) | 240 ; stream) |
| 239 (if (not (symbol-function sym)) | 241 ; (if (not (symbol-function sym)) |
| 240 (prin1 (symbol-value sym) stream) | 242 ; (prin1 (symbol-value sym) stream) |
| 241 (progn | 243 ; (progn |
| 242 (setq n (prin1-to-string (symbol-value sym)) | 244 ; (setq n (prin1-to-string (symbol-value sym)) |
| 243 pos (+ pos 6 (length n))) | 245 ; pos (+ pos 6 (length n))) |
| 244 (princ n stream) | 246 ; (princ n stream) |
| 245 (while (< pos 45) | 247 ; (while (< pos 45) |
| 246 (write-char ?\ stream) | 248 ; (write-char ?\ stream) |
| 247 (setq pos (1+ pos))) | 249 ; (setq pos (1+ pos))) |
| 248 (prin1 (symbol-function sym) stream))) | 250 ; (prin1 (symbol-function sym) stream))) |
| 249 (terpri stream))))) | 251 ; (terpri stream))))) |
| 250 table) | 252 ; table) |
| 251 (terpri stream)) | 253 ; (terpri stream)) |
| 252 (progn | 254 ; (progn |
| 253 (princ "\(define-abbrev-table '" stream) | 255 ; (princ "\(define-abbrev-table '" stream) |
| 254 (prin1 name stream) | 256 ; (prin1 name stream) |
| 255 (princ " '\(\n" stream) | 257 ; (princ " '\(\n" stream) |
| 256 (mapatoms (function (lambda (sym) | 258 ; (mapatoms (function (lambda (sym) |
| 257 (if (symbol-value sym) | 259 ; (if (symbol-value sym) |
| 258 (progn | 260 ; (progn |
| 259 (princ " " stream) | 261 ; (princ " " stream) |
| 260 (prin1 (list (symbol-name sym) | 262 ; (prin1 (list (symbol-name sym) |
| 261 (symbol-value sym) | 263 ; (symbol-value sym) |
| 262 (symbol-function sym) | 264 ; (symbol-function sym) |
| 263 (symbol-plist sym)) | 265 ; (symbol-plist sym)) |
| 264 stream) | 266 ; stream) |
| 265 (terpri stream))))) | 267 ; (terpri stream))))) |
| 266 table) | 268 ; table) |
| 267 (princ " \)\)\n" stream))) | 269 ; (princ " \)\)\n" stream))) |
| 268 (terpri stream)) | 270 ; (terpri stream)) |
| 269 (message "")) | 271 ; (message "")) |
| 270 ;;; End code not in FSF | 272 ;;; End code not in FSF |
| 271 | 273 |
| 272 (defun abbrev-mode (arg) | 274 (defun abbrev-mode (arg) |
| 273 "Toggle abbrev mode. | 275 "Toggle abbrev mode. |
| 274 With argument ARG, enable abbrev mode if ARG is positive, else disable. | 276 With argument ARG, enable abbrev mode if ARG is positive, else disable. |